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1.0 Introduction 


^ a rocke1 r can assume complex configurations due to 

multipie tanks, ^tipie engines, and structures that must be piped 
h ■ ' n ? e capability to handle seme of these complex configurations 

thrJSS ^^*ted^to the AEMIT code * capability tomodify 

the input on line has been implemented. * 

S7fi? lrati J nS a ^ lGWed include n^tiple tanks, multiple engines, 
the splitting of a pipe into unequal segments going to different for 

Sements eng:mes * 11113 Pncgram will handle the following type 


Straight pipes 
Bends 

Inline accumulators 
Tuned stub accumulators 
Helmholtz resonators 
Parallel resonators 
Pumps 

Split pipes 
Multiple tanks 
Multiple engines 
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2.0 Input Description 


ADMIT uses the following files: ENG. RLN, LOX.RIN, and FUEL. RUN. All 
files are in free format, therefore each of the following records will 
give the same results. 


Record 1: 1.000000E-01 6219.000000 2.670000 2.330E-03 -315.0000 

Record 2: 0.1 6219.0 2.67 0.00233 -315.0 

Record 3: l.E-01 

6219.0 
2.67 
2.33E-3 
-315.0 

The file assignments are given in the following table: 


Unit 

File Name 

File Type 

Description 

9 

ENG.RIN 

Input 

Engine data 

10 

LOX.RLN 

Input 

LOX tanks & lines data 

11 

FUEL. RLN 

Input 

Fuel tanks & lines data 

13 

SURF. ERR 

Output 

Convergence error information 

14 

SURF. OUT 

Output 

Admittance values 

15 

(LOX) 

Work 

Temporary file with LOX data 

16 

(FUEL) 

Work 

Temporary file with fuel data 

17 

(RESULT) 

Work 

Temporary file for results 


2.1 Description of file ENG.RLN 

Card # 1 

number of engines 
Card # 2 

total flow in engine (lbm/sec) , 
chamber pressure (lbf/ft~2) , 
pressure drop across orifice (lbf/ft‘2) 
Read card # 2 "number of engines" times 


2.2 Description of files LOX.RLN or FUEL . RLN 

Card # 1 
title 
Card # 2 

number of tanks 
Card # 3 

volume (ft~3) , 
mass flew (lbm/sec) , 
bulk modulus (lbf/ft“2) , 
density (lbm/ft‘3) 

Read card # 3 "number of tanks" 
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Card # 4 

number of lines leaving tank 
Card # 5 

tank number, 

engine number (0 if split follows) 

Card # 6 

number of segments, 
number of unique splits 
Card # 7 

section type, 

pipel, 

pipe2, 

pipe3, 

pipe4, 

pipe5 

Read card # 7 "number of segments" times 
if split > 0 
Card # 8 

number of segments, 
number of identical lines, 
engine number 

Card # 9 

section type, 

pipel, 

pipe2, 

pipe3, 

pipe4, 

pipes 

Read card # 9 "number of segments" times 
Read card # 8-9 "number of splits" times 
Read card # 5-9 "number of lines" times 


where 


type 

name 

PIPEL 

PIPE2 

PIPE3 

PIPE4 

PIPES 

0 

bend 

radius 

angle 

diameter 

end len. 


n 

straight 

length 

diameter 




2 

inline 

length 

diameter 




3 

tuned 

length 

diameter 




D 

Helmholtz 

length 

diameter 

volume 



5 

parallel 

length 

diameter 

volume 



6 

pump 

length 

diameter 

dp/dm 

L 

C 

7 

manifold 

volume 

bulk mod. 
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Dimensions: 

radius, length, diameter, end length 

angle 

volume 

dp/dm (non-dimens ionalized by m/p c ) 

L 

C 

bulk modulus 


- ft 

- deg 

- ft‘3 

- non-dimensional 

- sec 

- sec 

- lbf/ft“2 


3.0 Output Description 

3.1 Output Files 

Output from the program is a file (SURF. OUT) which may be printed and 
various graphs under the control of the user. The print file contains 
the following: 

Title, time, and date 

IJNE ENG. FREQ |G| G(R) G(I) 

line engine frequency amplitude of real part complex part 
no. no. admittance 

looking toward tank 

Also, if a split pipe is analyzed, a file (SURF. ERR) is created if any 
point fails to converge within the specified number of iterations. 

This file contains: 

Title, time, and date 

jw = after iterations has error of % 

1= J= |g|= | GOLD | = 


3.2 Graphs Available 

The graphs available are 

1. Plot of selected line on upper half of screen and 
admittance looking toward tank on lower half. 

2. Surface plot of pressure transfer function vs frequency and 
distance along pipe. The surface may be a wire frame or a 
solid surface. The view angle of the surface may be 
changed by the user. 

3. Contour plot of the pressure transfer function vs frequency 
and distance along pipe. Nine levels are plotted with 
levels 1, 5, and 9 emphasized and values printed at the 
side of the graph. 

The color scheme of each of the graph types may be changed by the user. 
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4 . 0 Sample Run 

The sample run consists of two lox tanks and four engines, two of the 
engines and lines going to them are identical. The total mass flow 
from each tank is the same, however the line from the first tank is 
split with half the mass flow going to engine # 2 and the other half 
split into two identical engines # 1. 

4.1 Input for Sample Run 

Sample ENG.RLN file: 

3 

853.5 4.502040E+05 1.610532E+06 

1707.0 4.502040E+05 1.610532E+06 

3414.0 4.502040E+05 1.610532E+06 

Sample LDX.RLN file: 

Sample Run 
2 

1.956300E+04 2928.0 1.185883E+07 71.4 

1.956300E+04 2928.0 1.185883E+07 71.4 

2 

1 0 
13 2 


1 

15.0 

1.416 

0.0 

0.0 

0.0 

0 

35.0 

45.0 

1.416 

0.0 

0.0 

1 

30.0 

1.416 

0.0 

0.0 

0.0 

0 

3.5 

135.0 

1.416 

0.0 

0.0 

1 

15.0 

1.416 

0.0 

0.0 

0.0 

1 

20.641 

1.416 

0.0 

0.0 

0.0 

1 

20.558 

1.416 

0.0 

0.0 

0.0 

1 

20.558 

1.416 

0.0 

0.0 

0.0 

1 

8.541 

1.416 

0.0 

0.0 

0.0 

1 

6.383 

1.416 

0.0 

0.0 

0.0 

0 

4.25 

90.0 

1.416 

0.0 

0.0 

1 

9.33 

1.416 

0.0 

0.0 

0.0 

0 

3.33 

80.0 

1.416 

0.0 

0.0 

5 

2 1 





1 

3.53 

0.708 

0.0 

0.0 

0.0 

1 

12.2 

0.708 

0.0 

0.0 

0.0 

0 

1.28 

35.0 

0.708 

0.0 

0.0 

1 

12.2 

0.708 

0.0 

0.0 

0.0 

7 

13.5 1. 

183346E+07 0.0 

0.0 

0.0 

5 

1 2 





1 

3.53 

1.00126 

0.0 

0.0 

0.0 

1 

12.2 

1.00126 

0.0 

0.0 

0.0 

0 

1.28 

35.0 

1.00126 

0.0 

0.0 

1 

12.2 

1.00126 

0.0 

0.0 

0.0 

7 

13.5 1. 

183346E+07 0.0 

0.0 

0.0 


5 



2 : 
18 


1 

15.0 


0.0 

0.0 

0.0 

0 

35.0 

45.0 

1.416 

0.0 

0.0 

1 

30.0 

1.416 

0.0 

0.0 

0.0 

0 

3.5 

135.0 

1.416 

0.0 

0.0 

1 

15.0 

1.416 

0.0 

0.0 

0.0 

1 

20.641 

1.416 

0.0 

0.0 

0.0 

1 

20.558 

1.416 

0.0 

0.0 

0.0 

1 

20.558 

1.416 

0.0 

0.0 

0.0 

1 

8.541 

1.416 

0.0 

0.0 

0.0 

1 

6.383 

1.416 

0.0 

0.0 

0.0 

0 

4.25 

90.0 

1.416 

0.0 

0.0 

1 

9.33 

1.416 

0.0 

0.0 

0.0 

0 

3.33 

80.0 

1.416 

0.0 

0.0 

1 

3.53 

1.416 

0.0 

0.0 

0.0 

1 

12.2 

1.416 

0.0 

0.0 

0.0 

0 

1.28 

35.0 

1.416 

0.0 

0.0 

1 

12.2 

1.416 

0.0 

0.0 

0.0 

7 

13.5 1. 

183346E+07 0.0 

0.0 

0.0 


4.2 Walkthrough of Sample Run 


Welcome to ADMIT - a Feedline Analysis Program 
To send a plot to the printer 
Ihe computer MUST be in GRAPHICS mode 
Hit PrScn to send the current plot to the printer 


Maximum no. of frequencies = 90 
Maximum points along pipe = 90 

If you want frequency in rad/sec, hit enter. 

If you want it in Hertz, enter "H" . h 
Is the engine data on file ENG.RLN? (Y/N) y 
Is this setup for FUEL or OXIDIZER? Enter F or O. g 
You did not enter F or O. Try again 
Is this setup for FUEL or OXIDIZER? Enter F or O. o 
Is the lox file name LOX.RIN? (Y/N) y 
Max. no. of iterations is set at 20 
Do you wish to change it? y 
Enter maximum no. of iterations 20 
Do you wish to modify lox line data? y 
Do you wish to change tank parameters? n 
Do you wish to change the pipe layout? n 
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Do you wish to plot piping & admittances? y 
The following LDX lines may be plotted 

Line § Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted, 0 will end plot 4 
You did not enter a valid line #. Try again 

Enter line # to be plotted, 0 will end plot 1 
Do you wish change colors of admittance? n 


vtoofphvj F.vjfc hlawk fum. i 



LOX Piping - Tank t 1 Engine t 1 



Sanple Run 10:17AI1 12-12-91 


8.55 
8.41 
M*- 8.27 
8.13 
8.88 

1.88 18.75 28.58 38.25 

Frequency - Hertz 



48.88 
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The following IOX lines may be plot ted 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted, 0 will end plot 
Do you wish change colors of admittance? n 



LOX Piping - Tank S 1 Engine i 2 



Sanple Run 18:17AH 12-12-91 



1.00 10.75 20.58 30.25 40.00 


Frequency - Hertz 
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The following LOX lines may be plotted 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted, 0 will end plot 
Do you wish change colors of admittance? n 
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LOX Piping - Tank S 2 Engine t 3 



1.88 10.75 28.58 30.25 40.00 


Frequency - Hertz 
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The following LOX lines may be plotted 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted, 0 will end plot 
Do you wish to plot surfaces? y 
Do you want a wire-frame drawing? y 
The following LOX lines may be plotted 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted, 0 will end plot 
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Sample Run 18: 17AM 12-12-91 

Pressure Transfer Function = f(freq (Hertz), distance (ft)) 
LOX Piping - Tank f 1 Engine t 1 





6.88 
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Current view is PHI = -45.000 THEIA = 30.000 
Do you wish another view? n 

Current BACKGROUND COLOR = 4 LINE COLOR = 1 FILL COLOR 

Do you wish another color? n 
Do you want a filled drawing? n 
Do you want another surface plot? y 
The following LOX lines may be plotted 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted, 0 will end plot 2 
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Sample Run 18: 17AM 12-12-91 

Pressure Iransfer Function = f (freq (Hertz ), distance (ft)) 
LOX Piping - Tank t 1 Engine I 2 



48.88 8.88 
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Current view is PHI = -45.000 THETA = 30.000 
Do you wish another view? n 


Current BACKGROUND COLOR = 4 LINE COLOR = 

Do you wish another color? n 
Do you want a filled drawing? n 
Do you want another surface plot? y 
The following IOX lines may be plotted 


1 FILL COLOR 


Line # Tank # Engine # 

1 1 1 

2 1 2 

3 2 3 

Enter line # to be plotted, 0 will end plot 3 
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Sample Run 18: 17AM 12-12-91 

Pressure Transfer Function = f(freq(Hertz),distance(ft)) 
LOX Piping - Tank I 2 Engine t 3 



48.88 8.88 
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Current view is PHI = -45.000 THETA = 30.000 

Do you wish another view? n 

Current BACKGROUND COLOR = 4 LINE COLOR = 1 FILL COLOR = 3 

Do you wish another color? n 
Do you want a filled drawing? n 
Do you want another surface plot? n 
Do you wish to plot contours? y 
The following L0X lines may be plotted 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted, 0 will end plot l 
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222.04-- 

177.63- 

133.22- 

X-ft. 

88.81- 

44.48 - 

8.00 — 
1.00 


Sanple Run 10:17AH 12-12-91 

LOX Piping - TanR i 1 Engine t 1 



8.80 16.60 24.48 32.20 40.00 

Frequency-Hertz 


CONTOUR VALUES 


1 * 1.252E*00 
5 * 6.261E+00 
9 * 1.127E*01 
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Current BACKGROUND COLOR = 4 LINE COLOR = 1 FILL COLOR = 3 

Do you wish another color? n 
Do you want another contour plot? y 
The following LUX lines may be plotted 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted, 0 will end plot 2 
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222.88 r 

177.66 

133.25 
X - ft. 

88.83- 

44.41- 

8 . 88 * — 
1.08 


Sample Bun 18:17AH 12-12-91 

LOX Piping - Tank I 1 Engine t 2 



8.80 16.68 24.48 32.28 48.80 

Frequency-Hertz 


CONTOUR UALUES 


1 * 1.533E+00 
5 * 7.665E+08 
9 * 1.379E+01 
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Current BACKGROUND COLOR = 4 LINE COLOR = 1 FILL OOLOR = 3 

Do you wish another color? n 
Do you want another contour plot? y 
The following LOX lines may be plotted 

Line # Tank # Engine # 

111 
2 12 

3 2 3 

Enter line # to be plotted, 0 will end plot 3 
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177.74 


133.31 j- 
X - ft. 

88.87- 


44.43 - 

8.80 L— 
1.08 


Sample Run 10: 17AM 12-12-91 

LOX Piping - Tank t 2 Engine I 3 



8.88 16.68 24.48 32.20 40.88 

Frequency-Hertz 


CONTOUR VALUES 


1 * 7.885E-01 
5 * 3.502E+08 
9 * 6.385E+00 
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Current BACKGROUND COLOR = 4 LINE COLOR = 1 F ILL COLOR = 3 

Do you wish another color? n 
Do you want another contour plot? n 

Enter E to exit, F to run new frequency range, or C to run a new case e 


4.3 Output for Sample Run 
SURF. OUT File 


Sample Run 


10:17AM 12-12-91 


LINE ENG. FREQ 


|G| 


G(R) G(I) 


2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 


1 1. 000000E+00 

2 1 . OOOOOOE+OO 

3 1. OOOOOOE+OO 

1 2. 000000E+00 

2 2. 000000E+00 

3 2. OOOOOOE+OO 

1 3 . 000000E+00 

2 3 . 000000E+00 

3 3. 000000E+00 

1 4 . OOOOOOE+OO 

2 4. OOOOOOE+OO 

3 4. OOOOOOE+OO 

1 5. OOOOOOE+OO 

2 5. OOOOOOE+OO 

3 5. OOOOOOE+OO 

1 6. OOOOOOE+OO 

2 6. OOOOOOE+OO 

3 6. OOOOOOE+OO 

1 7. OOOOOOE+OO 

2 7 . OOOOOOE+OO 

3 7. OOOOOOE+OO 

1 8. OOOOOOE+OO 

2 8. OOOOOOE+OO 

3 8. OOOOOOE+OO 

1 9. OOOOOOE+OO 

2 9. OOOOOOE+OO 

3 9. OOOOOOE+OO 

1 1. OOOOOOE+Ol 

2 1. 000000E+01 

3 1. OOOOOOE+Ol 

1 1. 100000E+01 

2 1. 100000E+01 

3 1. 100000E+01 

1 1.200000E+01 

2 1.200000E+01 

3 1.200000E+01 

1 1.300000E+01 

2 1. 300000E+01 

3 1. 300000E+01 


4.788069E-01 
2 . 394486E-01 
1. 198275E-01 
4 . 657790E-01 
2.325824E-01 
1. 190449E-01 
5.503493E-01 
2.571785E-01 
1. 187674E-01 
4.766055E-01 
2.385123E-01 
1. 198004E-01 
4 . 780528E-01 
2.393914E-01 
1. 198703E-01 
4.762524E-01 
2 . 394595E-01 
1. 198399E-01 
4 . 079117E-01 
2 . 172124E-01 
1. 191319E-01 
4.233197E-01 
2.265927E-01 
1. 187229E-01 
4.624276E-01 
2.366885E-01 
1. 197830E-01 
3 . 672516E-01 
2.294481E-01 
1. 198659E-01 
2.448379E-01 
2 . 088115E-01 
1. 198544E-01 
4.414459E-01 
2 . 131590E-01 
1 . 192847E-01 
4 . 622294E-01 
2 . 189573E-01 
1. 187096E-01 


4.785361E-01 

2.393604E-01 

1. 19783 IE-01 

4.623671E-01 

2.311172E-01 

1.182235E-01 

5.327964E-01 

2 . 552799E-01 

1. 17673 0E-01 

4.766044E-01 

2 . 384555E-01 

1.197289E-01 

4.774268E-01 

2.393727E-01 

1.198686E-01 

4.730391E-01 

2.391756E-01 

1.198079E-01 

3.857753E-01 

2.141030E-01 

1. 183965E-01 

4.232355E-01 

2.265922E-01 

1.175848E-01 

4.623034E-01 

2.365803E-01 

1. 196941E-01 

3 . 514259E-01 

2.286631E-01 

1.198599E-01 

2.441121E-01 

2 . 079123E-01 

1. 198369E-01 

4.064632E-01 

1.895564E-01 

1.187004E-01 

4.485251E-01 

2 . 039270E-01 

1. 175585E-01 


-1. 609942E-02 
-6 . 496578E-03 
-3 . 263087E-03 
-5. 627374E-02 
-2 . 606584E-02 
-1. 396010E-02 
-1.378852E-01 
-3 . 119238E-02 
1.608596E-02 
1. 030500E-03 
5.208500E-03 
4 . 137957E-03 
-2 . 445669E-02 
-2 . 990401E-03 
6.308582E-04 
-5 . 523042E-02 
-1. 165743E-02 
-2 . 7 69017E-03 
-1 . 325495E-01 
-3 . 662187E-02 
-1. 321685E-02 
-8 . 441784E-03 
4.792674E-04 
1. 639913E-02 
-1.071830E-02 
7.156707E-03 
4.613900E-03 
-1. 066469E-01 
-1.896343E-02 
1. 20003 6E-03 
1.883887E-02 
-1.935742E-02 
-2 . 050537E-03 
1.722271E-01 
-9.749433E-02 
-1 . 179237E-02 
1. 117195E— 01 
7.972505E-02 
1. 649133E-02 
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1.400000E401 
1.400000E+01 
1.400000E+01 
1. 500000E+01 
1.500000E+01 
1.500000E+01 
1. 600000E+01 
1 . 600000E+01 
1 . 600000E+01 
1.700000E+01 
1.700000E+01 
1.700000E+01 
1.800000E+01 
1.800000E+01 
1.800000E+01 
1.900000E+01 
1.900000E+01 
1.900000E+01 
2 . OOOOOOE+Ol 
2 . OOOOOOE+Ol 
2. OOOOOOE+Ol 
2 . lOOOOOE+Ol 
2 . lOOOOOE+Ol 
2 . lOOOOOE+Ol 
2.200000E+01 
2 . 200000E+01 
2.200000E+01 
2.300000E+01 
2 . 300000E+01 
2.300000E+01 
2 . 400000E+01 
2.400000E+01 
2 . 400000E+01 
2 . 500000E+01 
2 . 500000E+01 
2 . 500000E+01 
2 . 600000E+01 
2 . 600000E+01 
2 . 600000E+01 
2.700000E+01 
2.700000E+01 
2.700000E+01 
2 . 800000E+01 
2 . 800000E+01 
2.800000E+01 
2.900000E+01 
2 . 900000E+01 
2.900000E+01 
3 . OOOOOOE+Ol 
3 . OOOOOOE+Ol 
3 . OOOOOOE+Ol 
3 . lOOOOOE+Ol 
3 . lOOOOOE+Ol 


4.713571E-01 
2.354399E-01 
1. 197693E-01 
4.731210E-01 
2 . 383203E-01 
1 . 198598E-01 
4.523079E-01 
2 . 380467E-01 
1. 198648E-01 
4.475234E-01 
1. 15644 IE-01 
1. 194596E-01 
4.766612E-01 
2.380264E-01 
1.186682E-01 
4.774443E-01 
2.389633E-01 
1. 197584E-01 
4.777899E-01 
2.392843E-01 
1 . 198525E-01 
4.783327E-01 
2.397596E-01 
1. 198706E-01 
4 . 652513E-01 
2 • 290758E-01 
1. 196223E-01 
4 . 780885E-01 
2 . 388598E-01 
1. 185458E-01 
4.784867E-01 
2 . 393547E-01 
1. 197503E-01 
4 . 786937E-01 
2 . 395140E-01 
1. 198455E-01 
4.776323E-01 
2.396199E-01 
1. 198719E-01 
4 . 789912E-01 
2.398119E-01 
1. 197288E-01 
4.782868E-01 
2.387724E-01 
1. 184267E-01 
4.788788E-01 
2.394787E-01 
1. 197475E-01 
4.790309E-01 
2.396037E-01 
1. 198397E-01 
4.791116E-01 
2.396740E-01 


4.638380E-01 

2.320770E-01 

1.196667E-01 

4.672862E-01 

2.376733E-01 

1.198476E-01 

4.443953E-01 

2.379751E-01 

1.198577E-01 

4.409334E-01 

8.863128E-02 

1.190487E-01 

4.738513E-01 

2.363212E-01 

1.174765E-01 

4.754010E-01 

2.381845E-01 

1.196449E-01 

4.761115E-01 

2.388163E-01 

1.198331E-01 

4.768865E-01 

2.396848E-01 

1.198693E-01 

4.652245E-01 

2.264920E-01 

1.193733E-01 

4.766998E-01 

2.379776E-01 

1.172343E-01 

4.774878E-01 

2 . 389660E-01 

1.196288E-01 

4 . 778913E-01 

2 . 392779E-01 

1.198192E-01 

4.771558E-01 

2.394620E-01 

1.198719E-01 

4.782109E-01 

2.398077E-01 

1.195859E-01 

4.771689E-01 

2.378254E-01 

1.169989E-01 

4.782639E-01 

2.392083E-01 

1. 196231E-01 

4.785743E-01 

2.394635E-01 

1. 198075E-01 

4.787502E-01 

2.395971E-01 


8.385620E-02 
3.965155E-02 
4.955533E-03 
7.407471E-02 
1.754884E-02 
1. 708378E-03 
8.423349E-02 
5.836634E-03 
-1 . 305985E-03 
7 . 65174 6E-02 
7.428367E-02 
-9.899915E-03 
5. 167995E-02 
2.843990E-02 
1. 67752 IE-02 
4.412425E-02 
1.927782E-02 
5.212376E-03 
4 . 001329E-02 
1.495858E-02 
2 . 156888E-03 
3.716701E-02 
5.987594E-03 
-5.658274E-04 
4.999885E-03 
-3.430861E-02 
-7.715418E-03 
3 . 641302E-02 
2 . 051019E-02 
1.758482E-02 
3. 09027 IE-02 
1. 363386E-02 
5.392987E-03 
2.770607E-02 
1.063214E-02 
2.515019E-03 
2.133126E-02 
8. 695636E-03 
7.350634E-05 
2.732805E-02 
-1.413772E-03 
-5.848744E-03 
3.268143E-02 
2.124559E-02 
1.833409E-02 
2.425972E-02 
1. 137745E-02 
5.455597E-03 
2.090940E-02 
8. 194673E-03 
2.778069E-03 
1.860632E-02 
6. 069809E-03 



4 

2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 
2 

3 

4 


3 3 . 100000E+01 1. 198703E-01 1.198687E-01 6.262391E-04 

1 3.200000E+01 4.803177E-01 4.799417E-01 1.900072E-02 

2 3.200000E+01 2.400549E-01 2.400206E-01 4.056983E-03 

3 3 . 200000E+01 1.198015E-01 1.197311E-01 -4 . 106218E-03 

1 3. 300000E+01 4 . 790590E-01 4.785014E-01 2.310689E-02 

2 3 . 300000E+01 2.176105E-01 1.985928E-01 -8 . 896764E-02 

3 3 . 300000E+01 1. 180506E-01 1.162569E-01 2.050054E-02 

1 3.400000E+01 4.789846E-01 4.784731E-01 2.212913E-02 

2 3.400000E+01 2.394739E-01 2.391977E-01 1.149797E-02 

3 3.400000E+01 1.197451E-01 1.196184E-01 5.507161E-03 

1 3.500000E+01 4.792055E-01 4.789122E-01 1.676319E-02 

2 3 . 500000E+01 2.396382E-01 2.395265E-01 7.317231E-03 

3 3 . 500000E+01 1.198345E-01 1.197972E-01 2.992857E-03 

1 3 . 600000E+01 4.793263E-01 4.791647E-01 1.244263E-02 

2 3 . 600000E+01 2.397091E-01 2.396743E-01 4.086869E-03 

3 3 . 600000E+01 1.198667E-01 1.198615E-01 1.120276E-03 

1 3.700000E+01 4 . 805382E-01 4.804518E-01 9.113684E-03 

2 3.700000E+01 2.429025E-01 2.428962E-01 1.760611E-03 

3 3 . 700000E+01 1.198457E-01 1.198194E-01 -2 . 508721E-03 

1 3.800000E+01 4 . 725722E-01 4.723404E-01 1.479767E-02 

2 3 . 800000E+01 2.343988E-01 2.343544E-01 4.565530E-03 

3 3.800000E+01 1.165618E-01 1.133431E-01 2.720287E-02 

1 3 . 900000E+01 4.791271E-01 4.787291E-01 1.952631E-02 

2 3 . 900000E+01 2.390585E-01 2.383714E-01 1.811246E-02 

3 3 . 900000E+01 1.197435E-01 1.196153E-01 5.540901E-03 

1 4 . OOOOOOE+Ol 4.792343E-01 4.789645E-01 1.607835E-02 

2 4. OOOOOOE+Ol 2 . 396228E-01 2.394977E-01 7.741811E-03 

3 4. OOOOOOE+Ol 1. 198312E-01 1.197905E-01 3.123407E-03 


SURF. ERR File 

Sample Run 08:59AM 12-13-91 

jw = 37.0 after 20 iterations has error of 3.218% 

1= 4 J= 3 | G | = 5.4623E-02 |GOID|= 5.2920E-02 

jw = 38.0 after 20 iterations has error of 26.770% 

1= 1 J= 3 I G | = 1 . 5091E-02 |GOID|= 1.1904E-02 
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5.0 Flow Diagram 


MAIN 


MAINP —I 


- ENGNO 

FUEL 

- LOX 


y 


r- ADMIT 


FULOX A- KLINE 


J 


r- COOSH 
CIANH -I 

I— CSINH 

TANKNO 

PTYPE BENDS 


GINERT 


>— MODIFY —I 


L- MODEAN 


MODENG 

FKEQRS 


ZREAD 


i— LOWERW 


\— A HPT 


FTPLOT 


i— GETLIN 


PIPPIOT- 


r- UPPERW 


I— PLSECT —I 


\- HHSECT 


BNSECT -i 


STSECT 


TSSECT 


— XFUN 
I— YFUN 


I— SETPLT 


1 — ADMGRAPH 
i— WINDOW 


\— PLOTSU 


PLTOON 


_T 


GETZF — — GETLIN 
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6.0 Variable Description 


ADMBAC 

ADMLIN 


XC 

YC 

RAD 

ANG 

ANGLE 


MENG 

TFDDW(25) 

PCHMB(25) 

DPRDR(25) 

FMRAT(25) 


SFAC 


PIPEIF^S, 25) 
PrPE2F(75, 25) 
PIPE3F(75, 25) 
PIPE4F(75,25) 
PXPE5F(75,25) 


NSEC (75, 25) 
NPIS(25) 


MODE 

MODET 

NTROWS 

NTOOLS 

NPROWS 

NPOOLS 


MLINE 

SPLIT(25) 

A(25) 

CMAN(25) 

CTANK(25) 

DENS (25) 

KMAN(25) 

KIANK(25) 


Variables in Commons 


/ADMCOL/ 

INTEGER* 2 maximum value of admittance for plot 
INTEGER*2 line color of admittance plot 


/ ARCCON/ 

REAL*4 x coordinate of curve center 

REAL*4 y coordinate of curve center 

REAL*4 radius of bend 

REAL*4 angle of bend in radians 

REAL*4 angle of bend in degrees 


INTEGER* 2 

REAL*4 

REAL*4 

REAL*4 

REAL*4 


/EPARAM/ 

number of engines 

total flew rate of engine (ltm/sec) 
chamber pressure (lbf/ft“2) 
pressure drop across orifices (lbf/ft~2) 
chamber pressure/total mass flow 


/FACTOR/ 

REAL*4 factor for frequency 

/FOPIPE/ 

REAL*4 first parameter of pipe description 
REAL* 4 second parameter of pipe description 

REAL*4 third parameter of pipe description 

REAL*4 fourth parameter of pipe description 

REAL*4 fifth parameter of pipe description 

/ INTVAL/ 

INTEGER* 2 number of integration points in a section 
INTEGER* 2 number of surface points in a line 


INTEGER*2 
INTEGER*2 
INTEGER* 2 
INTEGER* 2 
INTEGER* 2 
INTEGER*2 


INTEGER* 2 

REAL*4 

REAL*4 

REAL* 4 

REAL*4 

REAL*4 

REAL*4 

REAL*4 


/NOCOL/ 

graphics mode of monitor 

text mode of monitor 

number of text rows for graphics 

number of text columns for graphics 

number of pixel rows for graphics 

number of pixel columns for graphics 

/PARAM/ 

number of lines from tank 

number of unique lines from pipe split 

speed of sound in the fluid (ft/sec) 

manifold capacitance 

tank capacitance 

density of fluid (lbm/ft‘3) 

bulk modulus of manifold (lbf/ft'2) 

bulk modulus of tank (lbf/ft‘2) 
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LFLCW(25) 

VOL (25) 

VOIMF(25) 

AREA(75,25) 

DIA(75, 25) 

L(75,25) 

PIND(75,25) 

PCAP(75, 25) 

AVGK(25) 

SBGMNF(25) 

SECINF(75,25) 

NOLINE (25) 

IENG(25) 

ITANK(25) 

DOPOLD(25) 

IOPEND(25) 


X 

XH 

XL 

Y 

YH 

YL 

XMIN 

XMAX 

YMIN 

YMAX 

SINA 

OOSA 


PHPE1(150) 

PXPE2 (150) 

PIPE3 (150) 

PIPE4 (150) 

NING(25) 

NIANK(25) 

NLINE(25) 

NSP(25) 

NEM)(25) 

TLTNE 

SBGMN 

SECIN(150) 


MIANK 


NAMLIN(2) 


REAL*4 

REALM 

REALM 

REAL*4 

REALM 

REALM 

REALM 

REALM 

REALM 

INTEGER*2 

INTBGER*2 

INTE3ER*2 

INTEGER*2 

INTBSER*2 

INTEGER*2 

INTE3ER*2 


flow rate through pipe (Itm/sec) 
volume of tank (ft‘3) 
volume of manifold (ft‘3) 
area of pipe section (ft *2) 
diameter of pipe section (ft) 
length of pipe section (ft) 
inductance of pipe section 
capacitance of pipe section 
average hulk modulus 
number of pipe sections 
pipe section type 
number of identical lines 
engine number 
tank number 

previous maximum number of iterations 
maximum number of iterations for split pipe 


REALM 

REALM 

REALM 

REALM 

REALM 

REALM 

REALM 

REALM 

REALM 

REALM 

REALM 

REALM 


/PIPPXY/ 

x location of current centerline 
x location of current upper pipe 
x location of current lower pipe 
y location of current centerline 
y location of current upper pipe 
y location of current lower pipe 
minimum x value of piping layout 
maximum x value of piping layout 
minimum y value of piping layout 
maximum y value of piping layout 
sine of current pipe direction 
cosine of current pipe direction 


REALM 

REALM 

REALM 

REALM 

INTEGER* 2 

INTEGER*2 

INTEGER* 2 

INTEGER*2 

INTEGER*2 

INTEGER*2 

INTEGER*2 

INTEGER*2 


/SETUP/ 

current first parameter of pipe description 

current second parameter of pipe description 

current third parameter of pipe description 

current fourth parameter of pipe description 

engine for a line 

tank for a line 

section number for a line 

starting line number 

ending line number 

current line 

current number of pipe sections 
current pipe section type 


/TANK/ 

INTEGER* 2 number of tanks 


/ WCAOUT 

CHAR*24 name of file containing pipe description 
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/WCAPAS/ 


IFRST 

INTEGER*2 

flag for admittance plot 



/WCATIT/ 

TITLE 

CHARM 0 

title for plots 

TTTL 

CHAR*20 

title from pipe file 

IHR 

INTEGER* 2 

hour code run 

IMIN 

INTEGER*2 

minute code run 

AP 

CHAR* 2 

AM or EM 

IYR 

INTEGER* 2 

yesr code run 

ra 

INTEGER*2 

month code run 

IDAY 

INTEGER*2 

day code run 


/ W0RK1/ 

G(0:75,25) 

C0MPLEX*8 

admittance looking toward tank 

ZT(0:75,25) 

COMPLEX* 8 

impedance looking toward tank 

ZG(0:75,25) 

C0MPLEX*8 

impedance looking toward engine 


/W0RK2/ 

ZO(75,25) 

REAL*4 

characteristic impedance 

PROGRAM ADMIT 




Determines maximum array sizes 


I 

IERR 

IXMAX 

IYMAX 

X(IXMAX, IYMAX) 
XF (IXMAX) 

Y (IXMAX, IYMAX) 
YF(IYMAX) 

Z (IXMAX, IYMAX) 
ZF (IXMAX, IYMAX) 


Local Variables 


INTEGERM 

do loop index 

INTEGER* 2 

error flag for ALLOCATE 

INTEGERM 

maximum number of frequencies 

INTEGERM 

maximum number of points along piping 

REALM 

frequency array for plotting 

REALM 

frequency array 

REALM 

location array for plotting 

REALM 

location array 

REALM 

gain array for plotting 

REALM 

gain array 


SUBROUTINE MAINP(X,Y, Z,XF,YF, ZF, IXMAX, IYMAX) 
Logic portion of code 


Commons EPARAM 
WCA3TT 


IXMAX 

IYMAX 

X (IXMAX, IYMAX) 
XF (IXMAX) 

Y (IXMAX, IYMAX) 
YF(IYMAX) 

Z (IXMAX, IYMAX) 
ZF( IXMAX, IYMAX) 


FACTOR FOPIPE INTVAL PARAM SETUP WCAOUT 
W0RK1 W0RK2 

Variables in Argument List 
INTEGER*4 maximum number of frequencies 
INTEGER* 4 maximum number of points along piping 
REALM frequency array for plotting 

REALM frequency array 

REALM location array for plotting 

REALM location array 

REALM gain array for plotting 

REALM gain array 
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AM 

ANS 

GADM(25) 

HFREQ 

I 

IFUEL 

IFUIOX 

IGONE 

HOX 

IOPEN 

IP 

ISEC 

ISIZ 

ISIZZ 

1100 

J 

JJ 

JUNIT 

K 

LFREQ 

NAMENG 

FM 

PIS 

S 

SSIZE 

W 


Local Variables 


CHAR*2 

CHAR*1 

OOMPLEX*8 

REAL* 4 

INTEGER* 2 

INTEGER*2 

INTEGER*2 

INTEGER*2 

INTEGER*2 

INTEGER* 2 

INTEGER*2 

INTEGER*2 

INTEGER*2 

INTEGER*2 

INTEGER* 2 

INTEGER*2 

INTEGER* 2 

INTEGER*2 

INTEGER*2 

REAL*4 

CHAR*24 

CHAR*2 

INTEGER* 2 

CQMPLEX*8 

REAL* 4 

REAL*4 


'AM' 

response to question 
admittance looking toward tank 
maximum frequency requested 
do loop index 
fuel flag 

type line flag (fuel or lox) 
flag for subroutine fuel or lox 
lox flag 

flag indicating if SURF. ERR is open 
current pipe section 
second code run 

counter for number of integration segments 
counter for number of integration segments 
hundreth of second code run 
do loop index 
do loop index 

unit number of engine data file 
do loop index 

minimum frequency requested 
name of engine data file 
'FM' 

number of frequencies 
current frequency 
frequency step size 
oscillatory part of frequency 


SUBROUTINE AEMSRAPH 

Plots admittance curve 


Commons FACTOR 

AEMMAX 

HFREQ 

LFREQ 

XMAJ 

XMAX 

XMIN 

YMAJ 

YMAX 

YMIN 


NOCOL WCATIT 
Variables in Argument List 
REAL*4 maximum value of admittance for plot 

REAL*4 maximum frequency requested 

REAL*4 minimum frequency requested 

Local Variables 


REAL*4 
REAL*4 
REAL* 4 
REAL*4 
REAL*4 
REAL*4 


distance between tick marks on x axis 
maximum value of x 
mirtiimum value of x 

distance between tick marks on y axis 
maximum value of y 
mimimum value of y 


SUBROUTINE ADMIT 

Determines admittance looking toward tank 


Commons WCATIT 
A 

AREA(75,25) 


W0RK1 W0RK2 FACTOR 


Variables in Argument List 


REAL*4 

REAL*4 


speed of sound in the fluid (ft/sec) 
area of pipe section (ft~2) 
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CMAN(25) 

REAL* 4 

manifold capacitance 

CIANK 

REAL* 4 

tank capacitance 

DFROR(25) 

REAL* 4 

pressure drop across orifices (lbf/ft'2) 

GADM(25) 

COMPLEX* 8 

admittance looking toward tank 

IENG(25) 

INTEGER*2 

engine number 

IUNE 

INTEGER*2 

line number 

IP 

INTEGER*2 

current pipe section 

L(75,25) 

REAL*4 

length of pipe section (ft) 

LFLOW 

REAL*4 

flow rate through pipe (lbm/sec) 

LOPEND 

INTEGER*2 

maximum number of iterations for split pipe 

NOLINE (25) 

INTEGER* 2 

number of identical lines 

PCAP(75,25) 

REAL*4 

capacitance of pipe section 

PIND(75,25) 

REAL*4 

inductance of pipe section 

TWRAT(25) 

REAL*4 

chamber pressure/total mass flow 

S 

CCMPLEX*8 

current frequency 

SECIN(75,25) 

INTEGER* 2 

pipe section type 

SEGMN(25) 

INTEGER*2 

number of pipe sections 

SPLIT 

REAL*4 

number of unique lines from pipe split 

TFL£W(25) 

REAL*4 

total flow rate of engine (lbm/sec) 


Local Variables 

CAFM 

CCMPLEX*8 

intermediate variable 

CAPN 

CCMPLEX*8 

intermediate variable 

CFAC 

CCMPLEX*8 

intermediate variable 

ERRP 

REAL*4 

convergence error 

GDIF 

REAL* 4 

maximum difference in admittance 

GOLD (0:75, 25) 

C0MPLEX*8 

previous addmittance 

GRAV 

REAL*4 

gravitational constant (lbm-ft/lbf-sec~2) 

I 

INTEGER*2 

do loop index 

IE 

INTEGER*2 

current engine number 

IOPEN 

INTEGER*2 

flag indicating if SURF. ERR is open 

IWG 

INTEGER* 2 

first index of maximum error 

J 

INTEGER*2 

do loop index 

JWG 

INTEGER*2 

second index of maximum error 

K 

INTBGER*2 

do loop index 

KLOOP 

INTEGER*2 

do loop index 

IOPHI 

INTEGER* 2 

intermediate variable 

RATFM 

REAL*4 

intermediate variable 

RHS 

OCMPLEX*8 

intermediate variable 

TOOUNT 

REAL*4 

intermediate variable 

TL 

REAL*4 

length/speed of sound 

MASS 

REAL*4 

intermediate variable 

WG 

REAL*4 

intermediate variable 

WGOLD 

REAL*4 

intermediate variable 

ZGEFF 

C0MPLEX*8 

effective impedance for calculations 

ZLP 

REAL*4 

intermediate variable 

ZOEFF 

REAL*4 

effective ZO for calculations 

ZOR(25) 

REAL*4 

intermediate variable 

ZTEFF 

OCMPLEX*8 

effective Zt for calculations 

ZTOP 

REAL*4 

intermediate variable 
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SUBROUTINE ALLFT 

Supervises plot of admittance after calculations 
Commons NOCOL 



Variables 

in Argument List 

IFULOX 

INTEGER* 2 

type line flag (fuel or lox) 

IXMAX 

INTEGER* 2 

maximum number of frequencies 

IYMAX 

INTEGER* 2 

maximum number of points along piping 

PIS 

INTEGER*2 

number of frequencies 

X(PTS) 

REAL*4 

frequency array for plotting 

XP(IXMAX, IYMAX) 

REALM 

frequency array 

Y(PTS) 

REAL*4 

admittance array for plotting 

YP (IXMAX, IYMAX) 

REAL*4 

admittance array 


Local Variables 

AEMMAX 

REAL*4 

maximum value of admittance for plot 

I 

INTEGER*2 

do loop index 

IEXTEN 

INTEGER*2 

intermediate variable 

IG0 

INTEGER*2 

first time flag for unsplit pipes 

IKEY 

INTEGER* 2 

intermediate variable 

IPLOT 

INTBGER*2 

plot pointer for line 

SUBROUTINE BENDS 



Computes effective straight pipe for bend 



Variables 

in Argument List 

DIME 

REAL* 4 

effective diameter (ft) 

PXPE1 

REALM 

radius of bend (ft) 

PIPE2 

REALM 

angle of bend (degrees) 

PIPE3 

REALM 

diameter of bend (ft) 

PIPE4 

REALM 

length of end straight segments 

VALUE 

REALM 

effective length (ft) 


Local Variables 

GAMMA 

REALM 

intermediate variable 

IBEND 

REALM 

intermediate variable 

RATIO 

REALM 

intermediate variable 

Y 

REALM 

intermediate variable 


SUBROUTINE BNSECT 

Computes plot coordinates for a bend 


Commons ARCCON PIPPXY 


ITYPE(200) 

J 

PIPE1 

PIPE2 

PIPE3 

PIPE4 

ponn?(8,200) 


Variables in Argument List 
INTEGER* 2 type plot element 
INTEGER* 2 pointer to element 
REAL*4 first parameter of pipe description 
REAL*4 second parameter of pipe description 
REAL*4 third parameter of pipe description 
REAL*4 fourth parameter of pipe description 
REAL*4 description of plot element 
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Local Variables 


DIA 

REAL*4 

intermediate variable 

HOLD 

REAL*4 

intermediate variable 

PANG 

REAL*4 

intermediate variable 

SLENTH 

REAL*4 

intermediate variable 

XO 

REAL* 4 

intermediate variable 

XI 

REAL* 4 

intermediate variable 

X2 

REAL*4 

intermediate variable 

X3 

REAL* 4 

intermediate variable 

YO 

REAL*4 

intermediate variable 

Y1 

REAL*4 

intermediate variable 

Y2 

REAL*4 

intermediate variable 

Y3 

REAL*4 

intermediate variable 


COMPLEX 

FUNCTION COOSH 


Evaluates the complex hyperbolic cosine 


Variables 

in Argument List 

S 

COMPLEX* 8 

: current frequency 


Local Variables 

OOSHI 

REAL*4 

intermediate variable 

CQSHR 

REAL* 4 

intermediate variable 

LAMDA 

REAL*4 

real part of complex frequency 

MU 

REAL*4 

imaginary part of complex frequency 

COMPLEX 

FUNCTION CSINH 


Evaluates the complex hyperbolic sine 


Variables 

in Argument List 

S 

OCMPLEX*8 

current frequency 


Local Variables 

LAMDA 

REAL*4 

real part of complex frequency 

MU 

REAL* 4 

imaginary part of complex frequency 

SINHI 

REAL*4 

intermediate variable 

SINHR 

REAL*4 

intermediate variable 


COMPLEX FUNCTION CIANH 

Evaluates the complex hyperbolic tangent 

Variables in Argument List 
S C0MPLEX*8 current frequency 
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SUBROUTINE ENGNO 

Reads engine parameters 

Commons EPARAM 

Variables in Argument List 

IbNIT INTEGER* 2 unit number of engine file 

Local Variables 

I INTEGER* 2 do loop index 


SUBROUTINE FLPIOT 

Supervises plot of piping 


Commons EPARAM 

IRJLOX 

IGO 

HPIjOT 

I 

IUNIT 

J 

K 

LL 


FOPIPE PARAM SETUP 
Variables in Argument List 
3NTEGER*2 type line flag (fuel or lox) 
INTEGER* 2 first time flag for unsplit pipes 
INTEGER*2 plot pointer for line 
Local Variables 
INTEGER* 2 pointer 
INTEGER*2 unit number of work file 
INTEGER*2 pointer 
INTEGER*2 counter 
INTEGER* 2 do loop index 


SUBROUTINE FREQRS 

Conputes pressure transfer function 


Commons EPARAM 

FOPIPE IN 
Variables 

DXHQLD ( IYMAX) 

REAL*4 

IYMAX 

INTEGER*2 

K 

INTEGER* 2 

S 

CCMPLEX*8 

YF (IYMAX) 

REAL*4 

ZF (IYMAX) 

REAL*4 

ZFHOLD( IYMAX) 

REAL*4 
Local Vari; 

BOTTOM 

0QMPLEX*8 

CAPM 

0CMPLEX*8 

CAPN 

C0MPLEX*8 

DX 

REAL*4 

I 

INTBGER*2 

IP 

INTEGER* 2 

IPP 

INTEGER* 2 

ISTART 

INTEGER*2 

J 

INTEGER*2 

JJ 

INTBGER*2 

KK 

INTEGER* 2 

LITTLN 

C0MPLEX*8 

LSEC 

INTBGER*2 

M 

INTEGER* 2 


VAL PARAM SETUP WORK1 WORK2 
n Argument Lis t 

array to hold dx values up to split 

maximum number of points along piping 

frequency pointer 

current frequency 

location array 

gain array 

array to hold gain up to split 
bles 

intermediate variable 

intermediate variable 

intermediate variable 

x increment 

do loop index 

current segment counter 

current line counter 

starting loop index 

do loop index 

do loop index 

do loop index 

intermediate variable 

number of segments of pipe section 

location pointer 
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MOLD 

PRAT 

SUMX 

TOP 

X 

ZFAC 


INTEGER*2 

CCMPLEX*8 

REAL*4 

OQMPLEX*8 

REALM 

COMPLEX* 8 


number of points from tank to split 
pressure ratio 
distance from orifice 
intermediate variable 
distance along pipe section 
intermediate variable 


sUURQt J 1 1 i~Nj k KIj ki i 

Handles fuel piping logic 


Commons EPARAM 

GF(25) 

IGONE 

IUNIT 

IUNITP 

S 

ANS 

FT TFT.TN 


POPIPE PARAM WCAOOT 
Variables in Argument List 
OQMPLEX*8 admittance looking toward tank 
INTEGER* 2 flag for subroutine fuel or lox 
INTEGER*2 unit number of fuel data file 
INrEGER*2 unit number of fuel work file 
OOMPLEX*8 current frequency 
Local Variables 


CHAR*1 response to question 

CHAR*24 name of fuel data file 


SUBROUTINE FULOX 

Handles read, modify, and admittance calls for fuel and lox 


Commons EPARAM 
A(25) 

AREA(75,25) 

AVGK(25) 

CMAN(25) 

CTANK(25) 

DENS (25) 

DIA(75, 25) 
GF(25) 

IENG(25) 

IGONE 

ITANK(25) 

ITLIN 

IUNIT 

IUNITP 

KMAN(25) 

KTANK(25) 

L(75,25) 

LFLCW(25) 

L0PEND(25) 

LOPOLD(25) 

MLINE 

NOLINE (25) 

PCAP(75,25) 

PIND(75, 25) 

PIPE1 (75,25) 


WCATTT 


Variables in Argument List 


REAL*4 

REAL*4 

REAL*4 

REAL*4 

REALM 

REAL*4 

REAL*4 

CCMPLEX*8 

INTEGER*2 

INTEGER* 2 

INTEGER* 2 

INTEGER*2 

INTEGER* 2 

INTEGER*2 

REALM 

REALM 

REALM 

REALM 

INTEGER*2 

INTEGER*2 

INTEGER* 2 

INTEGER* 2 

REAL*4 

REAL* 4 

REALM 


speed of sound in the fluid (ft/sec) 
area of pipe section (ft“2) 
average bulk modulus 
manifold capacitance 
tank capacitance 
density of fluid (lbm/ft‘3) 
diameter of pipe section (ft) 
admittance looking toward tank 
engine number 

flag for subroutine fuel or lox 
tank number 

flag indication fuel or lox 

unit number of piping data file 

unit number of working file 

bulk modulus of manifold (lbf/ft*2) 

bulk modulus of tank (lbf/ft“2) 

length of pipe section (ft) 

flew rate through pipe (lbm/sec) 

maximum number of iterations for split pipe 

previous maxim um number of iterations 

number of lines from tank 

number of identical lines 

capacitance of pipe section 

inductance of pipe section 

first parameter of pipe description 
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PIPE2 (75,25) 

REAL*4 

second parameter of pipe description 

PIPE3 (75,25) 

REAL* 4 

third parameter of pipe description 

PIPE4 (75,25) 

REAL*4 

fourth parameter of pipe description 

PIPE5 (75,25) 

REAL*4 

fifth parameter of pipe description 

S 

CCMPLEX*8 

current frequency 

SECIN(75,25) 

INTEGER*2 

pipe section type 

SEGMN(25) 

INTEGER* 2 

number of pipe sections 

SPLIT(25) 

REALM 

number of unique lines from pipe split 

VOL(25) 

REALM 

volume of tank (ft “3) 

VOIMF(25) 

REALM 

volume of manifold (ft~3) 


Local Variables 

ANS 

CHARM 

response to question 

I 

INTEGER* 2 

do loop index 

ILINE 

INTEGER* 2 

current line number 

IP 

INTEGER*2 

current segment number 

IT 

INTEGER*2 

current tank number 

QUEST1 (2) 

CHARM 0 

question array 

QUEST2 (2) 

CHARM 8 

question array 

QUEST3 (2) 

CHARM 0 

question array 



SUBROUTINE GETLIN 

Determines line to be plotted 

Commons EPARAM POPIPE PARAM SETUP 

Variables in Argument List 

IFULOX INTEGER*2 type line flag (fuel or lox) 

IGO INTEGER*2 first time flag for unsplit pipes 

rPLOT INTEGER* 2 plot pointer for line 

Local Variables 

ANS REAL*4 response to question 

I INTEGER*2 do loop index 

IP INTEGER* 2 pointer to current segment 

J INTEGER* 2 do loop index 


SUBROUTINE GETZF 

Determines pressure transfer function to be plotted 

Commons EPARAM INTVAL PARAM SETUP 

Variables in Argument List 

IGO INTESER*2 first time flag for unsplit pipes 

IFULOX INTEGER*2 type line flag (fuel or lox) 

IPIOT INTEGER* 2 plot pointer for line 

IPTS INTEGER* 2 number of frequencies 

IXMAX INTEGER* 2 maximum number of frequencies 

IYMAX INTEGER* 2 maximum number of points along piping 

JPTS INTEGER* 2 number of points on current line 

Y (IYMAX) REAL*4 intermediate array 

YF( IYMAX) REALM plot location array 

Z (IYMAX) REALM intermediate array 

ZF( IXMAX, IYMAX) REAL*4 plot transfer function array 


39 



I 

J 

JLIN 


K 


Local Variables 
INTEGER* 2 do loop index 
INTEGER*2 do loop index 
INTBGER*2 line pointer 
INTEGER*2 do loop index 


SUBROUTINE GINERT 

Evaluates curve fit of inertance of bends 

Variables in Argument List 
BEND REAL*4 angle of bend (degrees) 

X REAL*4 ratio of inner to outer radius 

Y REAL*4 inertance 

Local Variables 

A REAL* 4 intermediate variable 

B(3) REAL*4 coefficient array for inertance fit 



SUBROUTINE HHSECT 

Computes plot coordinates for Helmholtz resonator 


Commons PIPPXY 

Variables 

in Argument List 

DIA 

REAL*4 

diameter of opening (ft) 

ITYPE(200) 

INTEGER* 2 

type plot element 

J 

INTBGER*2 

pointer to element 

LEN 

REAL*4 

length of opening (ft) 

POINT (8, 200) 

REAL*4 

description of plot element 

VOL 

REAL*4 

volume of reservoir (ft~3) 


Local Variables 

COSOLD 

REAL*4 

intermediate variable 

DIAM 

REAL*4 

intermediate variable 

SIDE 

REAL*4 

intermediate variable 

SINOID 

REAL*4 

intermediate variable 

XC 

REAL*4 

intermediate variable 

XHOLD 

REAL* 4 

intermediate variable 

XLOLD 

REALM 

intermediate variable 

XOID 

REAL*4 

intermediate variable 

YC 

REAL*4 

intermediate variable 

YHOLD 

REAL*4 

intermediate variable 

YLOID 

REAL*4 

intermediate variable 

YOLD 

REAL*4 

intermediate variable 


SUBROUTINE LDWERW 

Sets up lower plotting window 

Commons AEMCOL NOCOL 

Variables in Argument List 

AEMMAX REAL* 4 maximum value of admittance for plot 

HFREQ REAL*4 maximum frequency requested 

LFREQ REALM minimum frequency requested 
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ASPECT 

IOPT 

JCOL1 

JOOL2 

JROW1 

JRDW2 

XLEN 

XMAX 

XMIN 

XORG 

YLEN 

YMAX 

YMTN 

YORG 

YOVERX 


Local Variables 


REAL*4 

INTEGER*2 

INTEGER*2 

INTEGER*2 

INTEGER* 2 

INTEGER* 2 

REAL*4 

REAL* 4 

REAL*4 

REAL*4 

REAL*4 

REAL*4 

REAL*4 

REAL*4 

REAL*4 


aspect ratio of monitor screen 

intermediate variable 

starting column for admittance window 

ending column for afdmittance window 

starting row for admittance window 

ending row for admittance window 

intermediate variable 

maximum x value for admittance plot 

minimum x value for admittance plot 

x origin for admittance plot 

intermediate variable 

maximum y value for admittance plot 

minimum y value for admittance plot 

Y origin for admittance plot 

intermediate variable 


SUBROUTINE LOX 

Handles lox piping logic 


Commons EPARAM 

GOX(25) 

IGONE 

IUNIT 

IUNITP 

S 

ANS 

LOXIN 


FOPIPE PARAM WCAOUT 
Variables in Argument List 
0QMPLEX*8 admittance looking toward tank 
INTEGER*2 flag for subroutine fuel or lox 
INTEGER*2 unit number of lox data file 
INTEGER*2 unit number of lox work file 
COMPLEX* 8 current frequency 
Local Variables 


CHAR*l response to question 

CHAR*24 name of lox da-t-g file 


SUBROUTINE MDDENG 

Modifies engine parameters 


Commons EPARAM 

IUNIT 

NAMENG 

ANS 

I 

II 
J 

NAME 

VALUE 

VARL(3) 

VARU(3) 


Variables in Argument List 
INTEGER* 2 unit number of engine data file 
CHAR*24 name of engine data file 
Local Variables 


CHAR*1 
INTEGER* 2 
INTEGER* 2 
INTEGER* 2 
CHAR*8 
REAL*4 
CHAR* 8 
CHAR*8 


response to question 
pointer 
do loop index 
do loop index 

name of variable to be modified 
value of variable to be modified 
array of names (lower case) 
array of names (upper cas e) 


41 


SUBROUTINE MODIFY 

Allows modifications to input data 


Commons EPARAM 
A(25) 

AREA(75, 25) 
AVGK(25) 
CMAN(25) 
CIANK(25) 

DENS (25) 
DIA(75,25) 
IENG(25) 
ITANK(25) 

IUNIT 

KMAN(25) 

KEANK(25) 

L(75,25) 

LFIOW(25) 

LOPEND(25) 

LOPOLD(25) 

MLINE 

NOLINE (25) 

PCAP(75,25) 

PIND(75,25) 

PIPE1(75,25) 

PIPE2 (75,25) 

PIPE3 (75,25) 

PIPE4(75 / 25) 

PIPES (75, 25) 

SECIN(75,25) 

SEGMN (25) 

SPLIT(25) 

TTTL 

VOL(25) 

VOIMF(25) 

ANS 

I 

II 

III 
IP 
IPP 
ISEEMN 
IT 

J 

K 

M 

NAMNAM 

SECT 


TANK WCAOUT 
Variables in Argument List 
REAL* 4 speed of sound in the fluid (ft/sec) 

REALM area of pipe section (ft'2) 

REAL*4 average bulk modulus 
REAL*4 manifold capacitance 

REALM tank capacitance 
REAL*4 density of fluid (lfcm/ft~3) 

REALM diameter of pipe section (ft) 

INTEGER* 2 engine number 
INTEGER* 2 tank number 

INTEGER*2 unit number of fuel or lox file 
REALM bulk modulus of manifold (lbf/ft‘2) 

REALM bulk modulus of tank (lbf/ft~2) 

REALM length of pipe section (ft) 

REALM flow rate through pipe (lbm/sec) 

INTEGER* 2 maximum number of iterations for split pipe 

INTEGER*2 previous maximum number of iterations 

INTEGER*2 number of lines frcm tank 

INTEGER* 2 number of identical lines 

REALM capacitance of pipe section 

REALM inductance of pipe section 

REAL* 4 first parameter of pipe description 

REALM second parameter of pipe description 

REALM third parameter of pipe description 

REALM fourth parameter of pipe description 

REALM fifth parameter of pipe description 

INTEGER*2 pipe section type 

INTEGER* 2 number of pipe sections 

REALM number of unique lines from pipe split 

CHAR*20 title frcm input file 

REALM volume of tank (ft“3) 

REALM volume of manifold (ft‘3) 

Local Variables 

CKAR*1 response to question 

INTEGER* 2 pointer 

INTEGER* 2 do loop index 

INruGER* 2 do loop index 

INTEEER*2 pointer to current segment 

INTEGER* 2 do loop index 

INTEGER* 2 intermediate variable 

INTEGER* 2 current tank number 

INTEGER* 2 do loop index 

INTEGER* 2 do loop index 

INTEGER* 2 do loop index 

INTEGER* 2 pointer, fuel or lox 

REALM type of segment 
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SUBROUTINE MODTAN 

Modifies tank parameters 



Variables 

in Argument List 

A(25) 

REAL*4 

speed of sound in the fluid (ft/sec) 

CIANK(25) 

REAL*4 

tank capacitance 

DENS (25) 

REAL* 4 

density of fluid (ltm/ft“3) 

KTANK(25) 

REAL*4 

bulk modulus of tank (lbf/ft‘2) 

LF1£W(25) 

REAL* 4 

flew rate through pipe (lkm/sec) 

MTANK 

INTEGER*2 

number of tanks 

VOL (25) 

REAL*4 

volume of tank (ft“3) 


Local Variables 

ANS 

CHAR*1 

response to question 

GRAV 

REAL*4 

gravitational constant ( lkm-f t / lbf -sec 

I 

INTEGER*2 

pointer 

II 

INTEGER*2 

do loop index 

J 

INTEGER* 2 

do loop index 

NAME 

CHAR* 8 

name of variable to be modified 

VALUE 

REAL*4 

value of variable to be modified 

VARL(4) 

CHAR*8 

array of names (lower case) 

VARU(4) 

CHAR* 8 

array of names (upper case) 

SUBROUTINE PIPPLOT 


Supervises plot of piping layout 

Commons ARCCJON 

PIPPXY 



Variables in Argument List 

IENG 

INTEGER* 2 

engine number 

nox 

INTEGER* 2 

flag for fuel or lox 

ITANK 

INTEGER* 2 

tank number 

PIPE1(75) 

REAL*4 

first parameter of pipe description 

PIPE2 (75) 

REAL*4 

second parameter of pipe description 

PIPE3 (75) 

REAL*4 

third parameter of pipe description 

PIPE4 (75) 

REAL* 4 

fourth parameter of pipe description 

SECIN(75) 

INTEGER*2 

pipe section type 

SEGMN 

TNTEGER*2 

number of pipe sections 


Local Variables 

I 

INTEGER* 2 

do loop index 

ITYPE(200) 

INTEGER*2 

type plot element 

J 

INTEGER* 2 

pointer to element 

POINT(8 / 200) 

REAL*4 

description of plot element 

XP(2) 

REAL*4 

x plot array 

XRANGE 

REAL* 4 

range of x values 

XO 

REAL* 4 

intermediate variable 

XI 

REAL*4 

intermediate variable 

X2 

REAL* 4 

intermediate variable 

X3 

REAL*4 

intermediate variable 

YP(2) 

REAL*4 

y plot array 

YRANGE 

REAL*4 

range of y values 

YO 

REAL*4 

intermediate variable 

Y1 

REAL* 4 

intermediate variable 

Y2 

REAL* 4 

intermediate variable 



Y3 


REALM 


intermediate variable 


SUBROUTINE PLCTSU 

Supervises the surface plot 

Commons FACTOR SETUP WCATIT 



Variables 

in Argument List 

IFULOX 

INTEGER* 2 

type line flag (fuel or lox) 

IPTS 

INTEGER* 2 

actual number of frequencies 

IXMAX 

INTEGER*4 

maximum number of frequencies 

IYMAX 

INTEGER*4 

maximum number of points along piping 

MLINE 

INTEGER*2 

number of separate lines 

X(IPTS, JPTS) 

REAL*4 

frequency array for plotting 

XF(IXMAX) 

REAL*4 

frequency array 

Y (IPTS, JPTS) 

REAL*4 

location array for plotting 

YF(IYMAX) 

REAL*4 

location array 

Z (IPTS, JPTS) 

REALM 

gain array for plotting 

ZF( IXMAX, IYMAX) 

REALM 

gain array 


Local Variables 

ANS 

CHARM 

response to question 

ASPECT 

REALM 

aspect ratio of monitor 

F0PIPE(2) 

CHARM 

name (fuel or lox) array for plot 

I 

INTEGER* 2 

do loop index 

IBOARD 

INTEGER* 2 

type graphics board installed 

ICOIR 

INTEGER* 2 

background color 

IEXTEN 

INTBGER*2 

extension of key hit 

IFTL 

INTEGER* 2 

fill color 

IGO 

INTEGER* 2 

flag for changes 

IGOO 

rNTEGER*2 

first time flag for unsplit pipes 

IKEY 

INTEGER* 2 

code of key hit 

HJN 

INTBGER*2 

line color 

ipiot 

INTEGER*2 

plot pointer for line 

IWIRE 

INTBGER*2 

flag for wire-frame or filled 

IWR 

INTEGER* 2 

temporary flag for wire-frame or filled 

IWRK1(640) 

INTEGER* 2 

work array for plot routine 

IWRK2 (640) 

INTEGER* 2 

work array for plot routine 

J 

INTEGER*2 

do loop index 

JPTS 

INTEGER*2 

number of points on current line 

LEGEND 

CHAR*45 

legend for OGA monitor 

LEGENDH 

CHAR*58 

legend for EGA or VGA monitor (Hertz) 

LEGENDR 

CHAR*58 

legend for EGA or VGA monitor (rad/ sec) 

MODE 

INTEGER*2 

graphics mode 

MODET 

INTEGER* 2 

text mode 

NOOLT 

INTEGER* 2 

number of columns in text mode 

P 

REAL*4 

phi rotation angle (degrees) 

PIPING 

CHAR*38 

array for line identification 

T 

REAL* 4 

theta rotation angle (degrees) 

XFAC 

REAL* 4 

intermediate variable 

XINV 

REAL*4 

intermediate variable 

XLEN 

REAL* 4 

length of x axis 

XMAJ 

REAL* 4 

distance between tick marks on x axis 

XMAX 

REAL*4 

maximum value for x axis 
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XMIN 

REAL*4 

minimum value for x axis 

XYZLEN 

REALM 

intermediate variable 

YFAC 

REALM 

intermediate variable 

YINV 

REALM 

intermediate variable 

YLEN 

REALM 

length of y axis 

YMAJ 

REALM 

distance between tick marks on y axis 

YMAX 

REAL*4 

maximum value for y axis 

YMIN 

REALM 

minimum value for y axis 

ZEAC 

REAL*4 

intermediate variable 

ZINV 

REALM 

intermediate variable 

ZLEN 

REALM 

length of z axis 

ZMAJ 

REAL*4 

distance between tick marks on z axis 

ZMAX 

REALM 

maximum value for z axis 

ZMIN 

REAL* 4 

minimum value for z axis 


SUBROUTINE PLSECT 

Computes plot coordinates for parallel resonator 


Commons ARCOON 

PLPPXY 

Variables 

in Argument List 

DIA 

REAL*4 

diameter of parallel segment (ft) 

IT¥PE(200) 

INTEGER* 2 

type plot element 

J 

INTEGER* 2 

pointer to element 

LEN 

REAL*4 

length of parallel segment (ft) 

POINr(8 / 200) 

REAL*4 

description of plot element 

VOL 

REAL*4 volume of bypassed segment (ft‘3) 

Local Variables 

ANGOLD 

REAL*4 

intermediate variable 

ANGSAV 

REAL*4 

intermediate variable 

OOSOLD 

REAL*4 

intermediate variable 

DIAM 

REAL*4 

intermediate variable 

PDIA 

REAL*4 

intermediate variable 

PLEN 

REAL*4 

intermediate variable 

RADIUS 

REAL*4 

intermediate variable 

SIDE 

REAL*4 

intermediate variable 

SINOLD 

REAL*4 

intermediate variable 

TORN 

REAL*4 

intermediate variable 

XHC 

REAL*4 

intermediate variable 

XHOLD 

REAL*4 

intermediate variable 

XHSAV 

REAL*4 

intermediate variable 

XLC 

REALM 

intermediate variable 

XLOLD 

REAL*4 

intermediate variable 

XLSAV 

REAL*4 

intermediate variable 

XOLD 

REAL*4 

intermediate variable 

XSAV 

REAL*4 

intermediate variable 

YHC 

REAL*4 

intermediate variable 

YHOLD 

REAL*4 

intermediate variable 

YHSAV 

REAL*4 

intermediate variable 

YLC 

REAL*4 

intermediate variable 

YLOLD 

REAL* 4 

intermediate variable 

YLSAV 

REAL* 4 

intermediate variable 

YOLD 

REALM 

intermediate variable 
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YSAV 


REAL* 4 


intermediate variable 


SUBROUTINE PLTCON 

Supervises plot of contour plot 


Commons FACTOR SETUP WCATTT 

Variables in Argument List 


IFULOX 

INTEGER*2 

type line flag (fuel or lox) 

IPTS 

INTEGER*2 

actual number of frequencies 

IXMAX 

INTEGER* 4 

maximum number of frequencies 

IYMAX 

INTEGER*4 

maximum number of points along piping 

MTiTNE 

INTEGER* 2 

number of separate lines 

X(XPTS) 

REAL*4 

frequency array for plotting 

XF(IXMAX) 

REAL*4 

frequency array 

Y (IYMAX) 

REAL*4 

location array for plotting 

YF(IYMAX) 

REAL*4 

location array 

Z (IPTS, IYMAX) 

REAL*4 

gain array for plotting 

ZF (IXMAX, IYMAX) 

REAL*4 

gain array 


Local Variables 

ANS 

REAL*4 

response to question 

ASPECT 

REAL*4 

aspect ratio of monitor 

CONS (10) 

REAL*4 

array for values of contour lines 

P0PIPE(2) 

CHAR* 4 

name (fuel or lox) array for plot 

I 

INTEGER* 2 

do loop index 

IBOARD 

INTEGER* 2 

type graphics board installed 

IOOLR 

INTEGER* 2 

background color 

IDEF 

INTEGER* 2 

flag for plot routine 

IEXTEN 

INTEGER*2 

extension of key hit 

IFTL 

INTBGER*2 

fill color 

IGO 

INTEGER*2 

first time flag for unsplit pipes 

IKEY 

INTEGER* 2 

code of key hit 

ILIN 

INTEGER* 2 

line color 

IOPT 

INTBGER*2 

flag for plot routine 

IPLOT 

INTEGER* 2 

plot pointer for line 

J 

INTEGER*2 

do loop index 

JC0L1 

INTBGER*2 

starting column for contour plot window 

JOOL2 

INTEGER* 2 

ending column for contour plot windcw 

JPTS 

INTBGER*2 

number of points on current line 

JR0W1 

INTEGER*2 

starting row for contour plot window 

JROW2 

INTEGER* 2 

ending row for contour plot window 

LABL(IO) 

INTEGER* 2 

flags for labeling contours 

MODE 

INTEGER*2 

graphics mode 

MODET 

INTEGER*2 

text mode 

NOOLT 

INTEGER* 2 

number of columns in text mode 

PIPING 

CHAR*38 

array for line identification 

XMAJ 

REAL*4 

distance between tick marks on x axis 

XMAX 

REAL*4 

maximum value for x axis 

XMIN 

REAL*4 

minimum value for x axis 

XORG 

REAL* 4 

origin of x axis 

YMAJ 

REAL* 4 

distance between tick marks on y axis 

YMAX 

REAL* 4 

maximum value for y axis 

YMIN 

REAL*4 

minimum value for y axis 
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YORG 

REAL*4 

origin of y axis 

YOVERX 

REAL*4 

intermediate variable 

ZLEN 

REAL*4 

intermediate variable 

ZMAX 

REAL*4 

maximum value for z 

ZMIN 

REAL* 4 

minimum value for z 

SUBROUTINE RUNE 




Reads fuel or lox file. 


Gammons EPARAM 
A(25) 

AREA(75, 25) 
AVGK(25) 
CMAN(25) 
CIANK(25) 

DENS (25) 
DIA(75,25) 
IENG(25) 
ITANK(25) 

IUNIT 

KMAN(25) 

KEANK(25) 

L(75,25) 

LFI£W(25) 

IOPEND(25) 

IOPOID(25) 

MLINE 

NOLINE (25) 

PCAP(75,25) 

PIND(75,25) 

PHPE1(75,25) 

PIPE2 (75,25) 

PIPE3 (75,25) 

PIPE4 (75,25) 

PXPE5(75,25) 

SECIN(75,25) 

SEGMN(25) 

SPUT(25) 

TITL 
VOL (25) 
VOIMF(25) 

ANS 

DIVAVG 

I 

IE 

IT 

J 

M 

MM 


TANK 

Variables in Argument List 
REAL*4 speed of sound in the fluid (ft/sec) 

REAL*4 area of pipe section (ft‘2) 

REAL*4 average bulk modulus 
REAL*4 manifold capacitance 
REAL*4 tank capacitance 
REAL*4 density of fluid (lhm/ft'‘3) 

REAL*4 diameter of pipe section (ft) 

INTEGER* 2 engine number 
INTEGER* 2 tank number 

INTEGER*2 unit number of fuel or lox file 
REAL*4 bulk modulus of manifold (lbf/ft~2) 

REAL*4 bulk modulus of tank (lbf/ft~2) 

REAL*4 length of pipe section (ft) 

REAL*4 flew rate through pipe (lbm/sec) 

INTEGER* 2 maximum number of iterations for split pipe 

INTEGER* 2 previous maximum number of iterations 

INTEGER* 2 number of lines from tank 

INTEGER* 2 number of identical lines 

REAL*4 capacitance of pipe section 

REAL* 4 inductance of pipe section 

REAL*4 first parameter of pipe description 

REAL* 4 second parameter of pipe description 

REAL*4 third parameter of pipe description 

REAL*4 fourth parameter of pipe description 

REAL*4 fifth parameter of pipe description 

INTEGER*2 pipe section type 

INTEGER*2 number of pipe sections 

REAL*4 number of unique lines from pipe split 

CHAR*20 title from input file 

REAL*4 volume of tank (ft~3) 

REAL*4 volume of manifold (ft“3) 

Local Variables 


CHAR*1 
REAL*4 
INTEGER* 2 
INTEGER* 2 
INTEGER* 2 
INTEGER*2 
INTEGER* 2 
INTEGER* 2 


response to question 
intermediate variable 
do loop index 
current engine number 
current tank number 
do loop index 
pointer 
do loop index 
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SUBROUTINE RTYPE 

Stores values for different types of piping 


Variables in Argument List 


AREA 

REAL*4 

area of pipe section (ft ‘2) 

AVGK 

REAL* 4 

average bulk modulus 

CWAN 

REAL*4 

manifold capacitance 

DENS 

REAL* 4 

density of fluid (lbm/ft~3) 

DIA 

REAL*4 

diameter of pipe section (ft) 

KMAN 

REAL*4 

bulk modulus of manifold (lbf/ft“2) 

L 

REAL*4 

length of pipe section (ft) 

PCAP 

REAL*4 

capacitance of pipe section 

PIND 

REAL*4 

inductance of pipe section 

PIPE1 

REAL*4 

first parameter of pipe description 

PIPE2 

REAL* 4 

second parameter of pipe description 

PIPES 

REAL*4 

third parameter of pipe description 

PIPE4 

REAL*4 

fourth parameter of pipe description 

PIPES 

REAL*4 

fifth parameter of pipe description 

SECIN 

INTEGER* 2 

pipe section type 

VOLMF 

REAL*4 

volume of manifold (ft“3) 


Local Variables 

AREAB 

REAL*4 

area of pipe 

DIME 

REAL*4 

diameter of pipe 

GRAV 

REAL*4 

gravitational constant (lbm-ft/lbf-sec' 

PI 

REAL*4 

mathematical constant 

VALUE 

REAL* 4 

length of pipe 

SUBROUTINE SETPLT 


Sets up the plot environment 

Commons AEMOOL 

NOCOL WCAPAS 


Local Variables 

ANS 

CHAR*1 

response to question 

IBQARD 

INTEGER*2 

type graphics board installed 

ITIM 

INTEGER*2 

flag for initialization 

NCOLT 

INTEGER* 2 

number of columns in text mode 

SUBROUTINE STSECT 


Computes plot coordinates for a straight section 

Commons PIPPXY 




Variables in Argument List 

DIA 

REAL*4 

diameter of segment (ft) 

ITYPE(200) 

INTEGER*2 

type plot element 

J 

INTE3ER*2 

pointer to element 

LEN 

REAL* 4 

length of segment (ft) 

POINT (8, 200) 

REAL*4 

description of plot element 


SUBROUTINE TANKNO 

Reads tank parameters 
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Variables in Argument List 


A(25) 

REAL*4 

speed of sound in the fluid (ft/sec) 

CIANK(25) 

REAL*4 

tank capacitance 

DENS (25) 

REAL*4 

density of fluid (ltm/ft~3) 

IUNIT 

INTBGER*2 

unit number of fuel or lox file 

KEANK(25) 

REAL*4 

bulk modulus of tank (lbf/ft‘2) 

LFLCW(25) 

REAL* 4 

flow rate through pipe (ltm/sec) 

MTANK 

INTEGER*2 

number of tanks 

V0L(25) 

REAL*4 

volume of tank (ft‘3) 


Local Variables 

GRAV 

REAL*4 

gravitational constant (lbm-ft/lbf-sec~; 

I 

TNTEGER*2 

do loop index 


SUBROUTINE TSSECT 

Computes plot coordinates for a tuned stub 
Commons PIPPXY 



Variables 

in Argument List 

DIA 

REAL*4 

diameter of tuned stub (ft) 

ITYPE(200) 

INTBGER*2 

type plot element 

J 

INTEGER* 2 

pointer to element 

LEN 

REAL*4 

length of tuned stub 

POINT (8, 200) 

REAL*4 

description of plot element 


Local Variables 

DIAM 

REAL*4 

intermediate variable 

SUBROUTINE UPPERW 


Sets up upper plotting window 

Commons AEMCOL 

NOOOL 



Variables 

in Argument List 

IENG 

INTEGER*2 

engine number 

IFULDX 

INTEGER*2 

type line flag (fuel or lox) 

HANK 

INTEGER* 2 

tank number 

xo 

REAL*4 

minimum value of x for piping layout window 

XI 

REAL*4 

maximum value of x for piping layout window 

Y0 

REAL*4 

minimum value of y for piping layout window 

Y1 

REAL*4 

maximum value of y for piping layout window 


Local Variables 

ASPECT 

REAL* 4 

aspect ratio of monitor 

CHANGE 

REAL*4 

intermediate variable 

FULOX 

CHAR*36 

array for line identification 

IOPT 

INTEGER*2 

flag for plot routine 

JC0L1 

INTEGER* 2 

starting column for pipe layout plot window 

JOOL2 

INTEGER*2 

ending column for pipe layout plot window 

JRCW1 

INTEGER*2 

starting row for pipe layout plot window 

JRCW2 

INTEGER* 2 

ending row for pipe layout plot window 

XMAX 

REAL*4 

maximum value for x axis 

XMIN 

REAL* 4 

minimum value for x axis 

XORG 

REAL*4 

origin of x axis 

YMAX 

REAL*4 

maximum value for x axis 
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YMAXO 

YMIN 

YORG 

YOVERX 


REAL*4 intermediate variable 

REAL* 4 minimum value for x axis 

REAL*4 origin of x axis 

REAL* 4 intermediate variable 


SUBROUTINE WINDOW 

Sets up window for surface plot 


MODE 

XFTN 

XSCALE 

XST 

YFIN 

YST 

ZFIN 

ZST 

ASPECT 

IOPT 

JOOL1 

JOOL2 

JR0W1 

JROW2 

XMAX 

XMIN 

XORG 

YMAX 

YMIN 

YORG 

YOVERX 


Variables in Argument List 
INTB3ER*2 graphics mode 
REAL*4 final x value 

REAL*4 aspect ratio of monitor 

REAL*4 starting x value 

REAL* 4 final y value 

REAL*4 starting y value 

REAL*4 final z value 

REAL*4 starting z value 

Local Variables 


REAL*4 

INTEGER*2 

INTEGER*2 

INTEGER*2 

INTEGER*2 

INTEGER*2 

REAL*4 

REAL*4 

REAL* 4 

REAL*4 

REAL*4 

REAL*4 

REAL*4 


aspect ratio of monitor 

flag for plot routine 

starting column for surface plot window 

ending column for surface plot window 

starting row for surface plot window 

ending row for surface plot window 

maximum value for x axis 

minimum value for x axis 

origin of x axis 

maximum value for y axis 

minimum value for y axis 

origin of y axis 

intermediate variable 


FUNCTION XFUN 

Parametric function for plotting of bends 
Commons AROOON 

Variables in Argument List 
T REAL*4 angle in radians 


FUNCTION YFUN 

Parametric function for plotting of bends 
Commons ARCOON 

Variables in Argument List 
T REAL*4 angle in radians 
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SUBROUTINE ZREAD 

Reads input for input modification 



Variables in 

Argument List 

NAME(8) 

CHAR*1 

name of input variable 

VALUE 

REAL*4 

value of input variable 


Local Variables 

BIK 

CHAR*1 

t • 

CARD(80) 

CHAR*1 

card image 

CEND(3) 

CHAR*1 

'E\ 'N', 'D' 

COMMA 

CHAR*1 

1 t 
/ 

CnT(5) 

CHAR*1 

•TVI', 'T', 'L', *E' 

DCARD 

CHAR*80 

card image 

E 

CHAR*1 

'E' 

FRACT 

REAL* 4 

fractional part of number 

I 

INTEGER* 2 

do loop index 

IOOUNT 

INTEGER* 2 

position counter 

ID 

INTEGER*2 

position counter 

II 

INTBGER*2 

position counter 

J 

INTEGER* 2 

do loop index 

JJ 

INTEGER* 2 

position counter 

LE 

CHAR*1 

'e' 

LEND(3) 

CHAR*1 

'e'/n'/d' 

LTIT(5) 

CHAR*1 

'tViVtVl', 'e' 

MINUS 

CHAR*1 

1 . 1 

NUMBER(IO) 

CHAR*1 

'O', '1', '2', '3', '4', '5', '6 

PERIOD 

CHAR*1 

i i 

PLUS 

CHAR*1 


POUND 

CHAR*1 

'#' 

QUEST 

CHAR*1 

• ? i 

SIGN 

REAL*4 

sign of number or exponent 

WHOLE 

REAL*4 

whole part of number 
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7.0 Program Listing 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PROGRAM ADMIT 03-24-92 

Program to compute and plot admittance coefficients, pipe layout, 
and pressure transfer function 

Variable Dimension Version 

This program will handle the following type elements 

Straight pipes 
Bends 

Split pipes (into identical lines) 

Inline accumulators 
Tuned stub accumulators 
Helmholtz resonators 
Parallel resonators 
Pumps 


INTEGERS IXMAX,IYMAX,I 

REAL X[ALLOCATABLE] ( : , : ) , Y[ALLOCAIABLE] Z [ALLOCAIABLE] 

* XF [ALLOCAIABLE] ( : ) , YF[ ALLOCAIABLE] ( : ) , ZF [ALLOCAIABLE] ( : , : ) 

DO 21 1=150,1,-1 
IXMAX=I 
IYMAX=I 
IERR — 0 

ALLOCATE (X( IXMAX, IYMAX) , Y(IXMAX,IYMAX) , Z (IXMAX, IYMAX) ,STAT=IERR) 
ALLOCATE (XF(IXMAX) , YF(IYMAX) , ZF (IXMAX, IYMAX) , STAT=IERR) 
IF(IERR.E2.0) GO TO 22 
DEALLOCATE (X, Y , Z , XF, YF, ZF, STAT=IERR) 

21 CONTINUE 
STOP 

22 CONTINUE 


CALL QCLEAR(0,7) 
WRITE(*, ' (10X,A) ') 



WRITE(*, ' (10X,A) ') 

* ' || Welcome to ADMIT - a Feedline Analysis Program 

WRITE(*, ' (10X,A) ') 

*•11 


WRITE(*, ' (10X, A) ') 

* ' || To send a plot to the printer 

WRITE(*, ' (10X,A) ') 

*1 


WRITE(*, ' (10X, A) ') 

*'|| The computer MUST be in GRAPHICS mode 

WRITER, ' (10X, A) ') 
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WRITER, ' (10X,A) ') 

* ' || Hit PrScn to send the current plot to the orinter 

WRITE (*, ' (10X,A) ') P <- to me printer 

*1 

WRITER, ' (10X,A) ') 


WRITE(*,*) ' ' " 

WR l'rt' (* / 1 (20X,A,I3) ' ) ' M a xim um no. of frequencies = ' txmax 
WE^(^I) ( ?°? ,A ' I3) ,Maxijnum P 0111 ^ alon 9 Pipe = ’’iYMAX 

CALL MAINP(X, Y, Z,XF, YF, ZF, IXMAX, IYMAX) 

STOP 

EM) 

SUBROUTINE MAINP (X, Y, Z, XF, YF, ZF, IXMAX, IYMAX) 

Logic portion of code 
INTEGER*4 IXMAX, IYMAX 

REAL X(IXMAX, IYMAX) , Y (IXMAX, IYMAX) , Z (IXMAX, IYMAX) 

REAL XF(IXMAX) , YF( IYMAX) ,ZF( IXMAX, IYMAX) 

INTEGER*2 PTS 

CHARACTER ANS*1 

CHARACTER*24 NAMLIN(2) ,NAMENG 

OCMCN /EPARAM/MENG,TFTOW(25) ,PCHMB(25) ,DPRDR(25) ,FMRAT(25) 

SI] :Sir ™ 25 > ™ . 

REAL KMAN(25) ,KIANK(25) ,LFLCW(25) ,L(75,25) ,LFREQ 
COMMON /PARAM/MLINE, SPLIT (25) ,A(25) ,CMAN(25) ,CTANK(25) , 

. DENS (25) ,KMAN,KTANK,LFLCW,VOL(25) ,V0LMF(25) 

AREA(75,25) ,DIA(75,25) ,L,PIND(75, 25) 

* PCAP(75,25) ,AVGK(25) , 

* rrwMriKi / SBa ‘ INF ' SECTNF, NOLINE, IENG, ITANK, LOPOID, DOPEND 

^COMMON / F0PIPE/PIPE1F (75,25) ,PrPE2F(75,25) ,PIPE3F(75,25) 

PIPE4F(75, 25) ,PIPE5F(75,25) ' 

INTEGER SEEMN,SECTN(150) 

COMMON /SETUP/PIPE1 (150) ,PIPE2 (150) ,PIPE3 (150) ,PIPE4 (150) 

* ' S i’ ZS T (25) ,NLINE(25) ,NSP(25) ,NEND(25) , LLINE, 

COMMON /WCAOUT/NAMLIN 

OCMfKW /INTVAL/NSEC(75, 25) ,NPTS(25) 

0O1PLEX G(0:75,25) ,ZT(0:75,25) ,ZG(0:75,25) ,S,GAEM(25) 

COMMON /WORK1/G, ZT, ZG 
COMMON /WORK2/ZO(75,25) 

INTBG ER * 2 I HR, IMIN, ISEC, 1100, IYR, IMON, IDAY 
CHARACTER* 2 AM,FM,AP 
CHARACTER*40 TITLE 
CHARACTER*20 TTIL 

raw; /w3tnT/TnLE, titl, ihr, don, ap, ito, dbn, kay 

COMMON / FACTOR/ SFAC 
DATA AM/'AM'/,FM/'FM'/ 

DATA IOPEN/O/ 

1 F0RMAT(2I5, 1P4E15. 6) 

2^FORMAT(/10X,A//^ ^LINE' , * ENG. ',5X, 'FREQ' ,11X, • |G| ',12X, 'G(R) 
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3 FORMAT (A20, 2X, 12 .2, 1 : 1 , 12 .2,A2,3X, 12.2, ,12.2, , 12 .2) 
OPEN (UNIT=17 , FORM= ' UNFORMATTED') 

OPEN (UNIT=14 , FILE>= ' SURF. OUT ' ) 

SFAC=1 . 0 

wnlf*'' filin'. 1 ^ 1 ™ want „ f ^ eq ^ enCi ' ^ ra<J / sec ' enter. 

y °“ “ Hertz ' " H "' ' 

IF(ANS.EQ. 'H'.OR.ANS.EJQ. 'h') SFAC=6. 283185 
LOPOLD=20 


CALL GEnTM(IHR, DON, ISE3C, 1100) 
CALL GEJIDAT ( IYR , DON , IDAY) 
IYR=IYR-1900 
IF(IHR.LT. 12) THEN 
AP=AM 


ELSE 


AP=FM 

IFfIHR.GT. 12) IHR=IHR-12 
ENDIF 

^AD(** : (Ar)ANS IS the ^ ° n ^ ENG ‘ RIW? ^/ N ) ' 

IF(ANS.NE. 'N' .AND.ANS.NE. 'n' ) THEN 
OPEN (UNTP=9 , FILE= ' ENG . RIN ' ) 

ELSE 

\ ' Enter name of file with the engine data ' 

RFAD(*, (A) ')NAMENG ^ 

OPEN (UNIT=9 , FILE=NAMENG) 

ENDIF 

JUNIT=9 

CALL ENGNO ( JUNIT) 

22 CONTINUE 
ISIZ=0 
IGONE=2 

^WRTTE(*, ' (A\) •) ' Is this setup for FUEL or OXIDIZER? Enter F or O 

READ(*, ' (A) ' ) ANS 
IFUELfI 
ILOX=l 

IF(ANS.EQ. 'F'.OR.ANS.EQ. 'f ') THEN 
IFUEL=0 
IFUL0X=1 

CALL FUEL(S,GAEM, 11,16, IGONE) 

ELSEIF(ANS.EQ. 'O' .OR.ANS.EQ. 'o') THEN 

3XOX=0 

IFULOX=2 

CALL IOX(S,GAEM, 10, 15, IGONE) 

ELSE 

WRITE(*,*) ' You did not enter F or O. Try again' 

GO TO 22 
ENDIF 

WRITE (TITLE, 3)TlTL, IHR, DON, AP, IMQN may XYP 
IGONE=0 

23 CONTINUE 

24 CONTINUE 
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25 CONTINUE 

WRITE(*,*)' ' 

WRITE (*,*) TITLE 
WRITE(*, *) ' » 

REWIND 17 

IF(SFAC.EQ.l.O) THEN 

WRITE (*,*) 1 Enter range of frequencies in rad/sec ' 

ELSE 

WRITE (*,*) ' Enter range of frequencies in Hertz 1 
ENDIF 

WRITER, *) ' Low freq, high freq, #pts' 

READ ( * , * ) LFREQ , HFREQ , PTS 
IF (PTS.LT.l) GO TO 34 
IF (PTS. GT. IXMAX) THEN 

WRITE (*,*) ' Maximum number of points for this option is IXMAX 
* IXMAX 

WRTIE(*, ' (A\) ') ' Do you want PTS reduced to IXMAX? Y or N ' 
READ(*, ' (A) ')ANS 

IF(ANS.EQ. 'N' .OR.ANS.EQ. 'n' ) GO TO 34 
PTS=IXMAX 
ENDIF 

IF (LFREQ. EQ. 0.0) LFREQ=1.0E-5 
SSIZE=0.0 

IF(PTS.NE.l) SSIZE= (HFREQ-LFREQ) / (PTS-1) 

IF(ISIZ.NE.O) THEN 

write (*, ' (A\) ') 1 Do you wish to change segments of sections? * 
READ(*, ' (A) ' ) ANS 

IF(ANS.EQ. 'Y' .OR.ANS.EQ. *y » ) GO TO 26 
GO TO 31 
ENDIF 

26 CONTINUE 
IP=0 

DO 30 J=1,MLINE 
IP=IP+1 
ISIZ=0 

DO 27 1=1 , SEGMNF ( IP) 

IF(SECINF(I, IP) .LE.l) THEN 

WRITE(*, ' (A,F10.5,A\) ') ' How many segments should this' , 

* L(I/IP) , ' ft. long section be broken into? ' 

READ(*,*)NSEC(I,IP) 

IF(NSEC(I,IP) .LE.l) NSEC (I, IP) =2 
ELSEIF(SECINF(I / IP) .EQ*2) THEN 
NSEC (I, IP) =2 
ELSE 

NSEC (I, IP) =2 
ENDIF 

ISIZ=ISIZ+NSEC ( I , IP) 

IF(ISIZ.GT.IYMAX) THEN 
WRITE(*,*) ' Too many segments ',ISIZ 
WRITER,*) ' Maximum is IYMAX =• IYMAX. ' Try aqain. ' 

GO TO 26 
ENDIF 

27 CCWITNUE 
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IF (SPLIT (J) .LE.O) GO TO 30 

ISIZZ=ISIZ 

DO 29 JJ=1, SPLIT (J) 

IP=IP+1 

ISIZ=ISIZZ 

DO 28 1=1, SBGMNF (IP) 

IF(SECTNF(I,IP) .LE.l) THEN 

WRTrE(*, ' (A,F10.5,A\) ') ' How many segments should this', 
* L(I,n > ),' ft. long section be broken into? ' 

READ(*, *)NSEC(I, IP) 

IF(NSEC(I,IP) .LE.l) NSEC (I, IP) =2 
ELSEIF ( SECINF ( I , IP) .EQ.2) THEN 
NSEC (I, IP) =2 
ELSE 

NSEC (I, IP) =2 
ENDIF 

ISIZ=ISIZ+NSEC(I,IP) 

IF(ISIZ.GT.IYMAX) THEN 
WRITE(*,*) ' Too many segments ' ,ISIZ 
WRITE (*, *) ' Maximum is IYMAX =' , IYMAX, 1 Try again. ' 

GO TO 26 
ENDIF 

28 CONTINUE 

29 CONTINUE 

30 CONTINUE 

31 CONTINUE 

WRITE ( 14 , 2 ) TITLE 

IF(IOPEN.NE.O.AND.LOPEND(1) .NE.l) THEN 
WRITE(13,*)' ' 

WRrTE(13,*) 1 ' 

WRITE ( 13 ,*) TITLE 
WRITE(13 , *) 1 ' 

ENDIF 

WRITE (*,*) 1 Calculations are proceeding' 

DO 33 K=l, PTS 
W=LFREQ+SSI ZE* (K-l) 

XF(K)=W 

S=CMPLX (0.0, W*SFAC) 

IF(IFUEL.E)Q.O) CALL FUEL(S,GAEM,11,16,IG0NE) 

IF(ILOX.EQ.O) CALL I£>X(S,GADM,10,15,IG0NE) 

CALL FREQRS(S, YF, ZF(1, 1) ,ZF(1,2) ,ZF(1,3) ,K, IYMAX) 

IP=0 

DO 32 1=1,25 
X(K,I)=W 

Y(K,I)=CABS(GADM(I) ) 

IF(IENG(I) .NE.O) THEN 
IP=IP+1 

WRITE(14,1)I,IENG(I) ,W,Y(K,IP) ,GADM(IP) 

ENDIF 

32 CONTINUE 

33 CONTINUE 

WRITE (*, ' (A\) ') ' Do you wish to plot piping & admittances? 1 
READ(*, ' (A) ')ANS 
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c 


IF(ANS.EQ. 'Y' .OR.ANS.BQ. 'y') THEN 
CALL ALLPT(X,Y,Z(1,1) ,Z(1,3) ,PT5,IXMAX,IYMAX,IFUlJ0X) 

ENDIF ' 

WRITE (*, ' (A\) ') ' Do you wish to plot surfaces? 1 
READ(*, ' (A) ')ANS 

IF(ANS.EQ. 'Y' .OR.ANS.BQ. *y ’ ) THEN 

^CALL PLOTSU(X, Y,Z,XF, YF, ZF ,PTS,IXMAX,IYMAX,IFTJLOX,MLINE*MING) 

' (A\) ') ' Do you wish to plot contours? ' 

READ(*,'(A) ')ANS 

IF(ANS.EQ. 'Y'. OR.ANS.BQ. 'y * ) THEN 

^CALL PLTCON (X, Y, Z , XF, YF, ZF, PTS , IXMAX, IYMAX, IFUDDX, MLINE*MENG) 
34 CONTINUE 

WRITE(*, ' (A\) ') 1 Enter E to exit, F to run new frequency range 
* C to run a new case ' 1 ^ ' 

READ(*, ' (A) ' ) ANS 

IF(ANS.E)Q. 'F'. OR.ANS.BQ. 'f') GO TO 25 
IF(ANS.EQ. »E'. OR.ANS.BQ. 'e') RETURN 
IF(ANS.E)Q. 'C'. OR.ANS.BQ. 'c') THEN 

WRIte (*, ' (A\) ') ' Do you wish to modify engine file." 5 ' 

READ(*, ' (A) ')ANS 

IF(ANS.EQ. 'Y' .OR.ANS.BQ. *y * ) THEN 
CALL MODENG ( JUNIT , NAMENG) 

ELSE 

WRITE (*, 1 (A\) 1 ) * Do you wish to rewind engine file • 
READ(*, ' (A) ')ANS 

IF(ANS.BQ. 'Y' .OR.ANS.BQ. *y * ) REWIND JUNTT 
CALL ENGNO (JUNIT) 

ENDIF 

IG0NE=1 

IF(IFULOX.BQ.l) THEN 
CALL FUEL(S,GADM,ll,16,IGONE) 

ELSE 

CALL LOX(S,GADM, 10, 15,IGONE) 

ENDIF 

WRITE(TTTLE, 3) TITL, IHR, DON, AP, IMON, IDAY, IYR 
ISIZ=0 
GO TO 25 
ENDIF 

TOj*> ' You did not enter E, F, or C. Try again. ' 

END 


SUBROUTINE ADMGRAFH(LFREQ,HFREQ,ADMMAX) 

Plots admittance curve 
CHARACTERS 0 TITLE 
CHARACTER* 20 TITL 
INTEGER*2 IHR, IMIN, IYR, DOl, IDAY 
CHARACTER* 2 AP 

COMMON /WCATIT/TTTLE,TTTL, IHR, IMIN, AP, IYR, IMON, IDAY 
COMMON /NOOOL/MODE , MODET , NIROWS , NTOOLS , NPROWS NPCOLS 
COMMON /FACTOR/SFAC 
REAL LFREJQ 


or 
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XMIN=LFRBQ 

XMAX=HFRB2 

YMIN=0. 0 

YMAX=ADMMAX 

XMAJ=0 . 25* (XMAX-XMIN) 

YMAJ=0 . 25* (YMAX-YMIN) 

IF (MODE. NE. 18) THEN 
CALL QFrXT( 40 ,TTTLE, 7 , 17 ,ll) 

ELSE 

CALL QPTXT(40,TTTLE,7, 17, 14) 

ENDIF 

CALL QXAXIS(XMIN,XMAX,XMAJ, 0,-1, 2) 

IF(SFAC.EQ. 1) THEN 

CALL QFTXTA(20, 'Frequency - rad/sec ’,7) 

ELSE 

CALL QFTXTA(20, ' Frequency - Hertz ',7) 

ENDIF 

CALL QYAXIS (YMIN,YMAX,YMAJ, 0,0,0) 

CALL QPTXTD(8, 'Adm. ',7) 

CALL QYAXIS (YMXN,YMAX,YMAJ, 0,-1, 2) 

RETURN 

END 

SUBROUTINE ACMIT(S,GArM,A,AREA,CMAN,CTANK,DFROR,L,LFLCW,EMRAT, 

* SBGMN,SECIN, SPLIT, DOPEND,PCAP,PIND,IENG,TFLOW, 

* NOLINE, IP, HINE) 

C Determines admittance looking tcward tank 

CHARACTER*40 TITLE 
CHARACTER* 20 TTTL 
INTB3ER*2 IHR,IMIN,IYR,IMCW,IDAY 
CHARACTER* 2 AP 

COMMON /WCATIT/TITLE , TTTL, IHR, IMIN, AP, IYR, IMON, IDAY 
INTEGER SEQVIN(25) ,SECIN(75,25) 

INTEGER IENG(25) ,NOUNE(25) 

REAL AREA(75,25) ,PCAP(75,25) ,PIND(75,25) ,L(75,25) ,LFL£W, ZO(75, 25) , 

* CMAN (25) ,DPROR(25) ,FMRAT(25) ,ZOR(25) ,TFIOW(25) 

COMPLEX G(0:75,25) ,ZT(0:75,25) ,ZG(0:75,25) ,GOID(0:75,25) ,GADM(25) , 

* S, ZGEFF, ZTEFF 
COMMON /WORK1/G, ZT, ZG 
COMMON /WORK2/ZO 
COMMON /FACTOR/ SFAC 

OCMPLEX CTANH,RHS,CFAC,CAPN,CAFM 
DATA GRAV/32.2/ 

DATA IOPEN/O/ 

ZTOP=A/ GRAV 
IMASS=0. 0 
TC0UNT=0. 0 
DO 22 J=IP, IP+SPLIT 
GOLD(0, J)=0. 0 
SECIN (SEX24N ( J) +1 , J) =0 
DO 21 I*1,SEGMN(J) 

GOLD (I, J) =0.0 
ZO(I,J)=0.0 

IF(SECTN(I, J) .LE.2) THEN 
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ZO ( I , J) =ZTOP/AREA ( I , J) 

ELSEIF(SECIN(I, J) .EQ.7) THEN 
ZO(I, J)=0.0 
ELSE 

ZO(I, J)=SQRT(PIND(I, J) /PCAP(I, J) ) 

ENDIF 

21 CONTINUE 
IF(IENG(J) .NE.O) THEN 

IE=IENG(J) 

ZOR(J) =2 . 0*DPROR(IE) /LFLOW 
IF(J.EQ.IP.AND.SPLIT.EQ.O.O) THEN 
TMASS=TFLOW(IE) 

ELSEEF (J.NE. IP) THEN 
TMASSKEMASS+NOLiINE ( J) *TFLOW ( IE) 

TODUNr=<[CDUNTM-NOLINE ( J) 

ENDIF 

ENDIF 

22 CONTINUE 

IF(TOOUNT.E)Q.O.O) TCOUNT=l . 0 
G(0, IP)=CTANK*S 
G(0 # IP)=G(0,IP) /TOOUNT 
ZT(0,IP)=1. 0/G(0,IP) 

DO 31 KLOOP=1 , LOPEND 
DO 25 J=rP, IP+SPLIT 
IF (J.NE. IP) THEN 
G(0, J)=G(SE)GMN (IP) ,IP) 

ZT(0, J) =1.0/G(0, J) 

ENDIF 

DO 24 I=1,SEGMN(J) 

ZGEFF=G ( 1-1 , J) 

IF(SECIN(I, J) .LE.l) THEN 
C bend in pipe or straight section 

TD=L(I, J) /A 

IF(KLOOP.NE.1.AND.SPLIT.NE.O.AND. J.NE.IP.AND.I.EQ.l) THEN 
ZGEFF=0.0 

EX) 23 K=IP+1 , IP+SPLIT 
IE=IENG (K) 

IF(K.E)Q.J) THEN 

ZGEFF=ZGEFF+ (NOLINE (K) -1.0) /ZG(0,K) 

ELSE 

ZGEFF=ZGEFF+NOUNE (K) / ZG ( 0 , K) 

ENDIF 

23 CONTINUE 

ZGEFF=G (SEGMN (IP) , IP) +ZGEFF 
ENDIF 

G(I, J) = (l. 04CEANH(S*TL) / (ZGEFF*ZO(I # J) ) ) / (1. 0+ZGEFF* 

* ZO(I, J) *CIANH(S*TL) ) 

ELSEIF(SECIN(I / J) .EQ.2) THEN 
C inline resonator 

G(I, J) =1. 0+PCAP(I, J) *S/ZGEFF 
EEjSEIF(SECIN(I, J) .BQ.3) THEN 
C tuned stub 

G(I, J)=1.0+CTANH(S*SQRT(PIND(I, J)*PCAP(I, J) ) ) / (ZO(I, J) * 
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ZGEFF) 

ELSEIF(SECIN(I, J) .BQ.4) THEN 
helmholtz resonator 

G(I,J) =L.0+S*PCAP(I,J)/(1.0+PIND(I,J) *PCAP(I,J) *S**2) /ZGEFF 
ELSEIF(SECIN(I,J) .BQ.5) THEN 
parallel resonator 
G(I, J)=PIND(I, J) *PCAP(I, J) *S**2+1 . 0 
G (I , J) =G (I , J) / (G (I , J) +PIND (I , J) *S*ZGEFF) 

ELSEUFfSECINfl, J) .EQ.6) THEN 
pump 

G(I,J) = (1.0+PCAP(I,J) *S/ZGEFF)/(1.0+(PIND(I,J)*S+ 

AREA(I, J) ) *(PCAP(I, J) *S+ZGEFF) ) 

ELSEIF(SECIN(I, J) .EQ.7) THEN 
G(SEGMN (J) , J) =1 . O+CMAN ( J) *S/ ZGEFF 
ENDIF 

G(I, J)=G(I, J) *ZGEFF 
ZT (I , J) =1 . 0/G ( I , J) 

CONTINUE 

IF(SPLIT.NE.0.0.AND. J.EQ.IP) GO TO 25 
G ( SEGMN ( J) +1 , J) =1 . 0/ ( 1 . 0+ZOR ( J) *G (SEGMN ( J) , J) ) 

G ( SEGMN ( J) +1 , J) =G (SEGMN ( J) +1 , J) *G (SEGMN ( J) , J) 

CONTINUE 

DO 28 J=IP+SPLIT, IP, -1 
IF(J. EQ. IP. AND. SPLIT. NE. 0.0) THEN 
L0PHI=SB3W(J) 

ELSE 

ZG ( SEGMN ( J) -1 , J) =ZOR ( J) / ( ZOR ( J) *CMAN ( J) *S+1 . 0 ) 

DOPHI=SEGMN(J) -2 
ENDIF 

IF(LOPHI.NE.O) THEN 
DO 27 I=LDPHI ,1,-1 

IF(I.EQ.LOFHI.AND. J.EQ.IP.AND.SPLIT.NE.0. 0) THEN 
ZG(I, J) =0.0 
ZTEE'E — ZT ( 1-1 , J) 

DO 26 K=IP+1,IP+SPLIT 
ZGEFF=ZG ( 1 , K) 

ZOEFF=ZO ( 1 , K) 

ZLP=L(1,K) 

TD=(L(I, J) +ZLP) /A 

CAPN= ( ZOEFF-ZTEFF) / (ZOEFF+ZTEFF) 

CAFM= ( ZOEFF-ZGEFF) / ( ZOEFF+ZGEFF) 

CFAC=CEXP (-2 . 0*S*TL) 

RHS= ( ZOEFF+ZGEFF) * ( 1 . 0-CAFN*CAPM*CFAC) *CEXP (S*ZLP /A) 
CFAC=CAPN *CFAC*CEXP ( 2 . 0*S*ZLP/A) 

ZG ( 0 , K) = (RHS-ZOEFF* ( 1 . 0-CFAC) ) / ( 1 . O+CFAC) 

ZG (I , J) =ZG (I , J) +NOUNE (K) /ZG(0, K) 

CONTINUE 

ZG(I, J)=l. 0/ZG(I, J) 

ELSE 

ZGEFF=ZG(I+1, J) 

ZOEFF=ZO(I+l,J) 

ZLP=L(I+1, J) 

ZTEFF=ZT(I-1, J) 



IF(SECIN(I+1,J) .LE.l) THEN 

bend in pipe or straight section 
TL=(L(I,J)+ZLP) /A 
CAPN= ( ZOEFF-ZTEFF) / (ZOEFF+ZTEFF) 

CAFM= ( ZOEFF-ZGEFF) / ( ZOEFF+ZGEFF) 

CFAC=CEXP ( -2 . 0*S*TL) 

RHS= ( ZOEFF+ZGEFF) * ( 1 . 0-CAPN*CAFM*CFAC) *CEXP ( S+ZLP/A) 
CFAC=CAPN*CFAC*CEXP ( 2 . 0*S*ZLP/A) 

ZG ( I , J) = (RHS-ZOEFF* ( 1 . 0-CFAC) ) / ( 1 . O+CFAC) 
ELSEIF(SECIN(I+1,J) .EQ.2) THEN 
inline resonator 

ZG(I, J) =ZGEFF/ (ZGEFF*PCAP(I+1, J) *S+1.0) 

EI5EIF(SECTN(I+1,J) .EQ.3) THEN 
tuned stub 

ZG ( I , J) =ZOEFF/ CIANH ( S*SQRT (PIND ( 1+1 , J) *PCAP(I+1, J) ) ) 

ZG(I, J) = (ZG(I, J) *ZGEFF) / (ZG(I, J)+ZGEFF) 

ELSEIF(SECIN(I+1, J) .EJQ.4) THEN 
he Imho It z resonator 

ZG(I, J) = (l. 0+PIND(I+l, J) *PCAP(I+1, J) *S**2 ) / (PCAP (1+1 , J) *S) 
ZG(I, J) = (ZG(I, J) *ZGEFF) / (ZG(I, JJ+ZGEFF) 

ELSEIF(SECIN(I+1 / J) .E3Q.5) THEN 
parallel resonator 

ZG ( I , J) =ZGEFF+PIND ( 1+1 , J) *S/ (PIND (1+1, J) *PCAP ( 1+1 , J) *S* *2+ 

* 1 . 0 ) 

ELSEIF(SECIN(I+1, J) .EQ.6) THEN 
pump 

ZG ( I , J) =ZGEFF+PIND ( 1+1 , J) *S-AREA (1+1 , J) 

ZG(I, J) =ZG(I, J) / (1.0+ZG(I, J) *PCAP(I+1, J) *S) 

ENDIF 

ENDIF 

27 CONTINUE 
ENDIF 

28 OCOTINUE 
ERRP=0.0 

DO 30 J=IP,IP+SPLIT 
DO 29 I=1,SEGMN(J) 

GDIF<ABS(GOID(I,J) ) 

IF(QDIF.NE.O.O) Q)IF=ABS (GDIF-CABS (G (I , J) ) ) /C3DIF 
IF (GDIF.GT. ERRP) THEN 
ERRP=GDIF 
WG=CABS(G(I, J) ) 

WGOLD=CABS(GOLD(I, J) ) 

IWG=I 

JVKXT 

ENDIF 

GOID(I, J)=G(I, J) 

29 OCmTNUE 

30 OCWTTNUE 

IF (KLOOP. GT. 1. AND.ERRP.LT. 0. 001) GO TO 32 

31 CONTINUE 

IF(LOPEND.EQ.l) GO TO 32 
IF(IOPEN.EQ.O) THEN 
OPEN (UNIT=13 , FILE= ' SURF. ERR ' ) 



wRrrE(i3,*)' ' 

WRrrE(i3 ; *)' ' 

WRITE (13,*) TITLE 
wRrrE(i3,*)' ' 

I0PEN=1 

ENDIF 

WRITE(13,'(" jw=",F8.1," after" ,13," iterations", 

* " has error of ",F8.3, "% ") ') 

* AIMAG(S) /SFAC,IDPEND,100.0*ERRP 

WRITE (13, • (10X, ' ' I=",I3,3X, • 'J=",I3,3X, • ' |G| = " ,1PE12.4,3X, 

* 1 ' | GOLD | = ' ' ,E12.4) ')IWG,JWG,WG,WGOLD 

32 CONTINUE 

DO 35 J=IP,IP+SPLIT 
IF (IENG ( J) . EQ. 0 . 0) THEN 
RATFM=0.0 

DO 33 I=IP+l,IPf SPLIT 
RATFM=RATEMf FMRAT ( IENG (I) ) 

33 OONTXNUE 
LOPHI=SB3^N(J) 

ELSE 

RAIFM=EMRAT(IENG(J) ) 

LOPHI=SBGMN ( J) +1 
ENDIF 

DO 34 1=0, IOPHI 
G ( I , J) =RATFM*G ( I , J) 

34 CONTINUE 

IF(J.EQ. IP. AND. SPLIT. NE. 0.0) GO TO 35 
GADM ( ILINE) =G (LOPHI , J) 

ILINE=ILINE+1 

35 CONTINUE 
RETURN 
END 

SUBROUTINE ALLPT(XP, YP,X, Y,PTS,IXMAX,IYMAX,IFUIOX) 

C Supervises plot of admittance after calculations 

INTEGER* 2 PTS 
INTEGER*4 IXMAX,IYMAX 

COMMON /NOCOL/MODE , MODET , NIROWS , NTOOLS , NPROWS , NPCOLS 
REAL X(PTS) , Y(PTS) ,XP(IXMAX, IYMAX) , YP(IXMAX,IYMAX) 

IGO=0 

21 CONTINUE 

CALL FLPLOT (IFULOX, IPLOT, IGO) 

IF(IPIOT.EQ.O) RETURN 
DO 22 1=1, PTS 
X(I)=XP(I,IPLCT) 

Y (I) =YP(I, IPLCT) 

22 CONTINUE 
ADMMAX=Y(1) 

DO 23 1=2, PTS 

IF(Y(I) .GT.A04MAX) ADMMAX=Y(I) 

23 CONTINUE 

CALL D0WERW(X(1) ,X(PTS) ,AEMMAX) 

CALL AEMGRAPH(X(1) ,X(PTS) ,AEMMAX) 

CALL QTABL(1,PTS,X,Y) 
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24 CONTINUE 

CALL QONKEY (IKEY) 

IF(IKEY.EQ.O) GO TO 24 
CALL QINKEY (IEXTEN, IKEY) 

CALL QSMODE (MODE!) 

GO TO 21 

RETURN 

END 

SUBROUTINE BENDS (PIPE1 , PIPE2 , PIPE3 , PIPE4 , VALUE , DIME) 

C Computes effective straight pipe for bend 

REAL LBEND 

IEEND=0 . 0174533*PIPE1*ABS (PIPE2 ) 

RATIO= (PIPE1-0 . 5*PIPE3 ) / (PIPEl+O . 5*PIPE3) 

CALL GINERT ( ABS ( PIPE2 ) , RATIO, Y) 

GAMMA= ( LBEND+Y *PIPE3 ) /LBEND 
VALUE=GAMMA* (LBEND+2 . 0*PIPE4 ) 

DIME=PIPE3 / (GAMMA) **0.25 

RETURN 

END 

SUBROUTINE BNSECT ( J , ITYPE , POINT , PIPE1 , PIPE2 , PIPE3 , PIPE4 ) 

C Computes plot coordinates for a bend 

COMMON /PIPPXY/X,XH,XL, Y,YH, YL,XMIN,XMAX,YMIN, YMAX,SINA / OOSA 
CCMMON /ARCCON/XC, YC, RAD, ANG, ANGLE 
REAL POINT (8, 200) 

INTEGER*2 ITYPE(200) 

C first straight section of bend 

IF(PIPE4.NE.0.0) CALL STSECT ( J, ITYPE, POINT, PIPE4 , PIPED ) 

C curved section of bend 

IF(PIPE2.GE.0.0) THEN 
XC=X-SINA*PIPE1 
YC=Y+OOSA*PIPE1 
DIA= 0.5 
ELSE 

XC=X+SINA*PIPE1 
YC=Y-C0SA*PIPE1 
DIA=-0 . 5 
ENDIF 
J=J+1 
ITYPE (J)=0 
POINT ( 1 , J) =XC 
POINT (2 ,J) =YC 
POINT ( 3 , J) =ANG 
ANG=ANG+0.01745329*PIPE2 
ANGLE=ANGLE+0 . 5*PIPE2 
RANG=0. 01745329*ANGLE 
COSA=COS (RANG) 

SINA=SIN (RANG) 

RAD=PIPE1-DIA*PIPE3 
POINT (4 , J) =ANG 
POINT ( 5 , J) =RAD 
X0=XC-RAD 
Y0=YC+RAD 
X1=XC+RAD 
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Y1=YC-RAD 

X2=XH 

Y2=YH 

SLENIH=2 . 0*RAD*SIN ( 0 . 00872665*ABS (PIPE2) ) 

XH=X24O0SA*SLENTH 

YH=Y2+SINA*SLENTH 

X3=XH 

Y3=YH 

IF(DIA.LT.O.O) THEN 
HOU>=X2 
X2-X3 
X3=HOLD 
HOID=Y2 
Y2=Y3 
Y3=HOI£> 

ENDIF 

RAD=PIPE1+DIA*PIPE3 

XO=XC-RAD 

YO=YC+RAD 

X1=XC+PAD 

Y1=YC-RAD 

X2=XL 

Y2=YL 

SLENIH=2 . 0*RAD*SIN (0 . 00872 665*ABS (PIPE2) ) 

XL?=X2+C0SA*SLEMTH 

YIfY2+SINA*SLENTH 

X3=XL 

Y3=YL 

IF(DIA.LT.O.O) THEN 
HOLD=X2 
X2=X3 
X3=HOLD 
HOU>=Y2 
Y2=Y3 
Y3=HOLD 
ENDIF 
J=J+1 
ITYPE ( J) =0 

POINT ( 1 , J) =POINT ( 1 , J-l) 

POINT ( 2 , J) =POINr ( 2 , J-l ) 

POINT ( 3 , J) =POINT ( 3 , J-l ) 

POINT (4 , J) =POINr (4 , J-l) 

POINT ( 5 , J) =RAD 

SLENIH=2 . 0*PIPE1*SIN ( 0 . 00872665*ABS (PIPE2) ) 

X=X4O0SA*SLENIH 

Y=Y+SINA*SLENTH 

XMIN=AMIN1 (X, XL, XH, XMIN) 

XMAX=AMAX1 (X, XL, XH, XMAX) 

YMIN=AMIN1(Y, YL, YH,YMIN) 

YMAX=AMAX1 ( Y , YL, YH, YMAX) 

C last straight section of bend 

ANGLE=ANGLE+0 . 5*PIPE2 
RANG=0 . 01745329*ANGLE 
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c 


c 


c 


COSA=COS (RANG) 

SINA=SIN (RANG) 

J=J+1 

ITYPE(J) =1 

POINT (1,J)=XH 

POINT ( 2, J) =YH 

POINT ( 3 , J) =XL 

POINT ( 4, J) =YL 

X=X+OOSA*PIPE4 

XH=X-0 . 5*SINA*PIPE3 

XLr=X+0 . 5*SINA*PXPE3 

Y=Y+SINA*PIPE4 

YH=Y+0 . 5 *OOSA*PIPE3 

YL=Y-0 . 5 *COSA*PIPE3 

POTNT(5, J)=XH 

POINT ( 6 , J) =YH 

POINr(7,J)=XL 

POINT ( 8 , J) =YL 

XMIN=AMIN1 (X, XL, XH, XMIN) 

XMAX-AMAX1 (X, XL, XH, XMAX) 

YMIN=AMIN1 (Y, YL, YH, YMIN) 

YMAX=AMAX1 (Y, YL, YH, YMAX) 
return 

END 

COMPLEX FUNCTION COOSH(S) 

cc Eva^tes the complex hyperbolic cosine 

REAL lamda, mu 
lamda=real ( S ) 

MU=AIMAG(S) 

OOSHR=OOSH (LAMDA) *COS (MU) 

OOSHI=SINH (LAMDA) *SIN (MU) 
COOSH=CMPLX(COSHR,OOSHI) 

RETURN 

END 


COMPLEX FUNCTION CSINH(S) 
Evaluates the complex hyperbol 
COMPLEX S ^ 

REAL LAMDA, MU 
LAMDA=REAL(S) 

MU=AIMAG(S) 


SINHR=SINH (LAMDA) *COS (MU) 
SINHI=OOSH (LAMDA) *SIN (MU) 
CSINH=CMPLX ( SINHR, SINHI ) 

RETURN 

END 


sine 


COMPLEX FUNCTION CTANH(S) 

hypertoUc 

CTANH=CSINH(S) /CCOSH(S) 
return 

END 


SUBROUTINE ENGNO(IUNIT) 
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C Reads engine parameters 

COMMON /EPARAM/MENG,TFLOW(25) ,PCHMB(25) ,DPROR(25) ,FMRAT(25) 

READ ( IUNIT , * ) MENG 
IF (MENG.GT.25) THEN 

WRITE (*, *) ' Number of engines must be less than 25' 

STOP 

ENDIF 

IF(MENG.LE.O) MENG=1 
DO 21 1=1, MENG 

READ (IUNIT, *)TFLOW (I) ,PCHMB(I) ,DPROR(I) 

FMRAT(I)=PCHMB(I) /TFLOW(I) 

21 CONTINUE 
RETURN 
END 

SUBROUTINE FIPDOT(IFULOX,IPLCT,IGO) 

C Supervises plot of piping 

COMMON /EPARAM/MENG,TFLOW(25) ,PCHMB(25) ,DFROR(25) ,EMRAT(25) 
INTEGER SECMNF(25) ,SECINF(75,25) ,NOUNE(25) ,IENG(25) ,ITANK(25) , 

* DDPOID(25) ,LOPEND(25) 

REAL KMAN(25) ,KTANK(25) ,LFLCW(25) ,L(75,25) 

COMMON /PARAM/MLTNE, SPLIT (25) ,A(25) ,CMAN(25) ,CTANK(25) , 

* DENS(25) ,KMAN,KTANK,LFLOW,VOL(25) ,VOIMF(25) , 

* AREA(75,25) ,DIA(75,25) ,L,PIND(75, 25) , 

* PCAP(75,25),AVGK(25), 

* SBGMNF , SECINF , NOLINE , IENG , ITANK , IOPOLD , IOPEND 
OCMMCN /FOPIPE/PrPElF(75,25) ,PIPE2F(75,25) ,PIPE3F(75, 25) , 

* PIPE4F(75,25) ,PIPE5F(75,25) 

INTEGER SEGMN, SECIN ( 150) 

O0MM0N / SETUP/PIPE1 ( 150) ,PIPE2 (150) ,PIPE3 (150) ,PIPE4 (150) , 

* NING(25) ,NIANK(25) ,NLINE(25) ,NSP(25) ,NEND(25) ,ILINE, 

* SEGMN, SECIN 
IF(IFUIOX.EQ.l) THEN 

IUNIT=16 

ELSE 

IUNIT=15 

ENDIF 

J=0 

CALL GETLIN (IFULOX, IPLOT, IGO) 

IF(IPLOT.EQ.O) RETURN 
J=NEND( IPLOT) 

I=NLINE( IPLOT) 

K=0 

SEGMN=0 

SEGMN=SEGMN+SEC3WINF ( I ) 

REWIND IUNIT 

READ (IUNIT) PIPE1F, PIPE2F, PIPE3F, PIPE4F, PIPE5F 
DO 26 LL=1,SEGMNF(I) 

K=K+1 

SECIN(K)=SECINF(LL, I) 

PIPE1 (K) =PIPE1F (LL, I) 

PIPE2 (K) =PIPE2F (LL, I) 

PIPE3 (K) =PIPE3F(LL, I) 

PIPE4 (K) =PIPE4F(LL, I) 
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26 CONTINUE 
IF(I.NE.J) THEN 

SEGMN^SEGMN+SEXMNF ( J) 

DO 27 U>1,SEGMNF(J) 

K=K+1 

SECIN (K) =SECINF (LL, J) 

PIPE1 (K) =PIPE1F (LL, J) 

PIPE2 (K) =PIPE2F(LL, J) 

PIPE3 (K) =PIPE3F (LL, J) 

PIPE4 (K) =PIPE4F (LL, J) 

27 CONTINUE 
ENDIF 

CALL SETPLT 

CALL PIPPLOT ( SEGMN , SECIN , PIPE1 , PIPE2 , PIPE3 , PIPE4 , IFULOX , 

* NTANK(IPLOT) ,NENG(IPLOT) ) 

RETURN 

END 

SUBROUTINE FREQRS(S,YF,ZF,ZFHOID,DXHOID,K,IYMAX) 

C Computes pressure transfer function 

COMPLEX G(0:75,25) ,ZT(0:75,25) ,ZG(0:75,25) ,S 
COMMON /WORK1/G, ZT, ZG 
COMMON /WORK2/ZO(75,25) 

COMPLEX LITTLN,CAFM,CAPN, ZFAC, TOP, BOTTOM, PRAT 
COMMON /INTVAL/NSEC(75,25) ,NPTS(25) 

COMMON /EPARAM/MENG,TFD0W(25) ,PCHMB(25) ,DPRDR(25) ,FMRAT(25) 
INTEGER SEGMNF(25) ,SECINF(75,25) ,NOLINE(25) ,IENG(25) ,ITANK(25) , 

* DOPOLD(25) ,L0PEND(25) 

REAL KMAN(25) ,KTANK(25) ,LF1£W(25) ,L(75,25) 

COMMON /PARAM/MLINE, SPLIT (25) ,A(25) ,CMAN(25) ,CTANK(25) , 

* DENS (25) ,KMAN,KTANK,LFUOW f VOL(25) ,VOIMF(25) , 

* AREA(75,25) ,DIA(75,25) ,L,PIND(75,25) , 

* PCAP(75,25) ,AVGK(25) , 

* SEGMNF, SECINF, NOLINE, IENG, ITANK, LOPOLD, IDPEND 
COMMON /P0PIPE/PIPE1F(75, 25) ,PIPE2F(75,25) ,PIPE3F(75, 25) , 

* PIPE4F(75,25) ,PIPE5F(75,25) 

INTEGER SEGMN, SECIN (150) 

COMMON /SEJTUP/PIPEl ( 150) ,PIPE2(150) ,PIPE3(150) ,PIPE4(150) , 

* NENG(25) ,NTANK(25) ,NUNE(25) ,NSP(25) ,NEND(25) ,ILINE, 

* SBGMN, SECIN 
INTEGER* 4 IYMAX 

REAL YF (IYMAX) ,ZF (IYMAX) , ZFHOLD( IYMAX) ,DXHOID( IYMAX) 

IP=0 

IPP=0 

DO 28 KK=1,MLINE 
IP=IP+1 
LITTLN=S/A(KK) 

SUMX=0. 0 
M=1 

ISTART=SEGMNF (IP) 

IF (SPLIT (KK) . EQ. 0) ISTART=ISTART-1 
DO 22 I=ISTART, 1,-1 

CAPN=(ZO(I, IP) -ZT(I-1, IP) ) /(ZO(I,IP)+2T(I-l,IP) ) 

CAPM= ( ZO ( I , IP ) - ZG ( I , IP ) ) / ( ZO ( I , IP) +ZG ( I , IP ) ) 
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ZFAOZO (I , IP) / (ZO (I , IP) +ZG (I , IP) ) 

LSEC=NSEC(I,IP) 

DX=0 . 0 

IF(SECTNF(I, IP) .EQ.3.0R.SECINF(I,IP) .BQ.4) THEN 
DX=DIA(I, IP) / (LSEC-1) 

ELSE 

DX=L(I, IP) /(LSEC-1) 

ENDIF 

BOITOM=1 . 0-CAFM*CAPN*CEXP (-2 . 0*LTTTLN*L(I,IP) ) 

DO 21 J=1 , LSEC 
X=DX* (J-l) 

IF(SECINF(I,IP).GT.1.AND.SECINF(I,IP).LT.6) THEN 
IF ( J. EQ . LSEC) FRAT=ZT (1-1 , IP) / (ZT (1-1 , IP) +ZG (I , IP) ) 
ELSE 

TOP=CEXP (-LnTUI*X) -CAPN*CEXP(-LrrrLN* (2 . 0*L(I, IP) -X) ) 
PRAT=ZFAC*TOP/BOITCW 
ENDIF 

IF(J.NE.l) THEN 
SUMX=SUMX+DX 
M=M+1 

ZF (M) =CABS (PRAT) 

YF (M) =SUMX 
ZFHOID (M) =ZF (M) 

DXHOLD (M) =DX 
ELSE 

IF ( I . EQ . ISTART) THEN 
ZF (M) =CABS (PRAT) 

YF(M)=SUMX 
ZFHOID (M)=ZF(M) 

DXHOLD (M) =0.0 
ENDIF 
ENDIF 

21 CONTINUE 

22 CONTINUE 

IF (SPLIT (KK) .LE.0.0) GO TO 27 
M0ID=M 

DO 26 JJ=1, SPLIT (KK) 

IP=IP+1 
IPP=IPP+1 
SUMX=0. 0 
M=1 

DO 24 I=SEGMNF(IP)-1,1,-1 
CAPN=(ZO(I,IP) -ZT(I-1,IP) ) / (ZO(I,IP)+ZT(I-l, IP) ) 
CATW=(ZO(I,IP)-ZG(I,IP))/(ZO(I,IP)+ZG(I / IP)) 

ZFAC=ZO ( I , IP) / ( ZO ( I , IP) +ZG ( I , IP) ) 

LSEC=NSEC ( I , IP) 

DX=0 . 0 

IF(SECINF(I,IP) . EQ.3.0R.SEdNF(I,IP) .E3Q.4) THEN 
DX=DIA (I, IP)/ (LSEC-1 ) 

ELSE 

DX=L(I, IP) /(LSEC-1) 

ENDIF 

BOTTOM=1 . 0-CAPM*CAPN*CEXP ( -2 . 0*UTTTN*L ( I , IP) ) 
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DO 23 J=1 , LSEC 
X=DX* ( J-l) 

IF(SECTNF(I,IP) .GT.1.AND.SECINF(I,IP) .LT.6) THEN 
IF(J.EQ.LSEC) PRAT=ZT(I-1, IP) / (ZT(I-1, IP) +ZG(I,IP) ) 
ELSE 

TOP=CEXP ( -KnTLN*X) H2APN*CTXP(-KrmN*(2.0*L(I.IP) -X) ) 
PRAT=ZFAC*TOP/BOTTCM 
ENDIF 

IF(J.NE.l) THEN 
SUMX=SUMX+DX 
M=Mfl 

ZF (M) =CABS (PRAT) 

YF(M)=SUMX 

ELSE 

IF(I.EQ.SEXMNF(IP)-1) THEN 
ZF (M) =CABS (PRAT) 

YF (M) =SUMX 
ENDIF 
ENDIF 

23 CONTINUE 

24 CONTINUE 

DO 25 1=1, MOLD 
M=M+1 

ZF (M) =ZFHOLD ( I ) 

YF (M) =YF (M-l) +DXHOLD (I) 

25 CONTINUE 

IF(K.EQ.l) NPTS(IPP)=M 
WRITE (17) YF,ZF 

26 CONTINUE 
GO TO 28 

27 CONTINUE 
IPP=IPP+1 

IF(K.E)Q.l) NPTS(IPP)=M 
WRITE (17) YF, ZF 

28 CONTINUE 
RETURN 
END 

SUBROUTINE FUEL(S,GF,IUNIT,IUNITP,IGCNE) 

C Handles fuel piping logic 

COMPLEX GF (25) ,S 

COMMON /EPARAM/MENG,TFLOW(25) ,PCHMB(25) ,DPROR(25) ,PMRAT(25) 
INTEGER SEGMN(25) ,SECIN(75,25) , NOLINE (25) , IENG (25) ,ITANK(25) , 

* LOPOLD(25) ,LOPEND(25) 

REAL KMAN(25) ,KTANK(25) ,LFIDW(25) ,L(75,25) 

COMMON /PARAM/MUNE, SPLIT (25) ,A(25) ,CMAN(25) ,CIANK(25) , 

* DENS(25) ,KMAN,KTANK,LFLCW,VOL(25) ,VOIMF(25) , 

* AREA(75, 25) ,DIA(75,25) ,L,PIND(75,25) , 

* PCAP(75,25) ,AVGK(25) , 

* SEGMN , SECIN , NOLINE, IENG, ITANK, IOPOLD, LOPEND 
COMMON /POPIPE/PIPE1 (75,25) ,PIPE2 (75,25) , PIPED (75,25) , 

* PIPE4 (75,25) , PIPES (75, 25) 

CHARACTER*24 FUELIN,NAMLIN(2) 

COMMON /WCAOUT /NAMLIN 
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* 

* 

* 


* 

* 

it 


CALL RLINE (TTIL, SEGMN , SECIN, PIPE1 , PXPE2 , PIPE3 

* ' L ' AREA ' DIA ' PIND ' PCAP ' LOPEND, LOPOLD, SPLIT, IUNIT 

* AVoS^' ° MS ' KMAN ' KTANK ' V0L ^ VOMF, NOLINE, IENG, ITANK, 

rewind iunitp 

WRITE ( IUNITP) PIPE1 , PIPE2 , PIPED , PIPE4 PIPE5 

WRITE (*, 1 (A\ )') QUEST1 ( ITLIN) 

READ(*, ' (A) ')ANS 

IF(ANS . EQ. 'Y* .OR. ANS . EQ. *y * ) THFTJ 
CALL MODIFY (TITL, SEGMN, SECIN, PIPE1,PIPE2,PIPE3 
?' I S^xt PIPE 5 ' L/ AREA ' DIA/ PIND, PCAP, LOPEND, tOPOID* SPLIT IUNIT 

REWIND IUNITP 

WRITE (IUNITP) PIPE1 , PIPE2 , PIPE3 , PIPE4 , PIPES 
ENDIF 

EISEIF(IGONE.EQ.O) THEN 
IP=1 
HiTNE)=l 

DO 21 I=1,MLINE 
IT=ITANK(I) 

CALL ADMIT(S,GF,A(IT) , AREA,CMAN,CTANK(IT) ,DPROR, 

L, LFIOW (IT) , FMRAT, SEGMN, SECIN, 

SPLIT (I) , LOPEND (I) , PCAP, PIND, IENG,TFIOW 
NOLINE, IP, JUNE) ' 

IP=IP+SPLIT ( I ) +1 
21 CONTINUE 
RETURN 

ELSEIF(IGONE .EQ. 1) THEN 
WRITE (*, • (A\) ')QUEST2(ITLIN) 

READ(*, ' (A) ' ) ANS 

IF (ANS .EQ. 'Y* .OR. ANS . EJQ. 'y') THEN 
CALL MODIFY (TTIL, SEGMN, SECIN, PIPE1, PIPE2 , PXPE3 

* a I ^M P SS^ L ' AREA ' DIA / PIND, PCAP, LOPEND, LOPOID ' SPLIT, IUNIT 

* AV^SST'^ DENS,KMAN,KTANK,LFIOW,VOL,V^^ 

REWIND IUNITP 

WRITE (IUNITP) PIPE1 , PIPE2 , PIPE3 , PIPE4 , PIPES 
ELSE 

WRITE(*, • (A\) ’ ) QUEST3 (ITLIN) 

READ(*, • (A) ' ) ANS 

IF(ANS .EQ. 'Y 1 .OR. ANS .EQ. 'y • ) REWIND IUNIT 

CALL RLINE(TTIL, SEGMN, SECIN, PIpLIpI^ Pn>™ 

' L ' AREA ' DIA ' P!ND, PCAP, LOPEND, LOPOLD, SPLIT IUNIT 
AvS^SeT' DENS ' KMAN ' KIANK ' LFl£M > V0L / VOLMF, NOLINE, IENG, ITANK, 
REWIND IUNITP 

WRITE ( IUNITP) PIPE1 , PIPE2 , PIPE3 , PIPE4 , PIPE5 
WRITE (*,*) QUEST1 ( ITLIN) 

J® ITE (*/ 1 (A\) ') ' if not, press enter key. ' 

READ(*,'(A) ')ANS 7 

WRITER,*)' ' 

IF(ANS .EQ. 'Y* .OR. ANS .EQ. 'y') THEN 


* 

* 

* 
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r V, * 


-LAfM M* *yi 


CALL MODIFY (TTTL, SEGMN, SECIN, PIPE1, PIPE2 , PIPE3 , 

* PIPE4, PIPE5,L, AREA, DIA,PIND,PCAP,LOPEND,lJOPOLD, SPLIT, IUNIT, 

* A , OMAN , CEANK , DENS , KMAN , KTANK , LFLOW, VOL, VOIMF , NOLINE , IENG , ITANK 

* AVGK, MLINE) 

REWIND IUNITP 

WRITE ( IUNITP) PIPE1 , PIPE2 , PIPE3 , PIPE4 , PIPE5 
ENDIF 
ENDIF 
IGONE=0 
ENDIF 
RETURN 
END 

SUBROUTINE GET1JN(IFUIOX,IPLOT,IGO) 

C Determines line to be plotted 

COMMON /EPARAM/MENG,TFU0W(25) ,PCHMB(25) ,DPROR(25) ,H1RAT(25) 
INTEGER SEGMNF(25) ,SECINF(75,25) ,NOUNE(25) , IENG(25) ,ITANK(25) , 

* LOPOLD(25) ,L0PEND(25) 

REAL KMAN(25) ,KTANK(25) ,LFL0W(25) ,L(75,25) 

OCMMON /PARAM/MLINE, SPLIT(25) ,A(25) ,CMAN(25) ,CEANK(25) , 

* DENS (25) , KMAN, KTANK, LFDCW,VOL(25) ,VOIMF(25) , 

* AREA(75,25) ,DIA(75,25) ,L,PIND(75,25) , 

* PCAP(75,25) ,AVGK(25) , 

* SBGMNF, SECTNF, NOLINE, IENG, ITANK, LOPOLD, DOPEND 
°°MMON / POPXPE/PIPE1F (75,25) ,PIPE2F(75,25) ,PIPE3F(75, 25) , 

* PIPE4F(75,25) ,PIPE5F(75,25) 

INTEGER SEGMN, SECTN( 150) 

CXMVm /SEIUP/PIPE1 (150) ,PIPE2 (150) ,PIPE3 (150) ,PIPE4 (150) , 

* NENG(25) ,NTANK(25) ,NUNE(25) ,NSP(25) ,NEND(25) , ILINE, 

* SEQW, SECIN 
IT.TNE=0 

IP=1 

DO 22 1=1, MLINE 
IF(SPLIT(I) .EQ.0.0) THEN 
II iTN E= ILINE+ 1 
NENG ( ILINE) =IENG ( IP) 

NTANK ( ILINE) =ITANK ( I ) 

NLINE( ILINE) =IP 
NSP (ILINE) =TT,TNF 
NEND( ILINE) =IP 
ELSE 

DO 21 J=IP+1 , IP+SPLIT ( I ) 

HJN E= TT .TN F+1 
NENG (ILINE) =IENG ( J) 

NTANK (ILINE) =ITANK(I) 

NLINE (ILINE) =IP 
NSP ( ILINE) = TT,TN E 
NEND( ILINE) =J 

21 CONTINUE 
ENDIF 

IP=IP+SPLIT ( I ) +1 

22 CONTINUE 

23 CONTINUE 

IF(LLINE.EQ.l) THEN 
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IF(IGO.EQ.O) THEN 
IPL0T=1 
ELSE 
rPLOT=0 
ENDIF 
IGO=l 
ELSE 

IF(IFUIOX.EQ.l) THEN 

WRite (*,*) ' The following FUEL lines may be plotted' 

WRITE (*, ' (/' 1 Line # Tank # Engine #' '/) ') 

ELSE 

WRITE(*,*) ' The following LDX lines may be plotted' 

WRITe ( * , 1 (/ 1 ' Line # Tank # Engine #' '/) ') 

ENDIF 

DO 24 I=1,ILINE 

WRITE(*, ' (15,110,111) ') I, NTANK(I) ,NENG(I) 

24 CONTINUE 

25 CONTINUE 

WRITE(*, ' (/" Enter line # to be plotted, 0 will end plot "\) ') 
READ(*,*) IPLOT 
IF(IPLOT.LE.O) RETURN 
IF(IPLOT.GT.ILINE) THEN 

WR1TE(*, *) ' You did not enter a valid line #. Try again' 

GO TO 25 
ENDIF 
ENDIF 
RETURN 
END 

SUBROUTINE GETZF(Y, Z, YF, ZF, IXMAX, IYMAX,IPTS, JFTS, IFUIOX, IPLOT, IGO) 
C Determines pressure transfer function to be plotted 

COMMON /EPARAM/MENG,TFLOW(25) ,PCHMB(25) ,DPROR(25) ,FMRAT(25) 
INTEGER SEGMNF(25) ,SECINF(75,25) ,NOLINF(25) ,IENGF(25) ,ITANKF(25) , 

* LOPOLF(25) ,IOPENF(25) 

REAL KMANF(25) ,KTANKF(25) ,LF1CWF(25) ,LF(75,25) 

OCM4CN /PARAM/MLINEF,SPLITF(25) ,AF(25) ,CMANF(25) ,CTANKF(25) , 

* DENSF(25) ,KMANF,KTANKF,LFICWF,VOLF(25) ,VOIMFF(25) , 

* AREAF(75,25) ,DIAF(75,25) ,LF,PINDF(75,25) , 

* PCAPF(75,25) ,AVGKF(25) , 

* SBGMNF, SECINF, NOLINF, IENGF, ITANKF, LOPOLF, IOPENF 
INTEGER SEX34N, SECTN ( 150) 

COMMON /SETUP/PIPE1(150) ,PIPE2 (150) ,PIPE3 (150) ,PIPE4 (150) , 

* NENG(25) ,NTANK(25) ,NLINE(25) ,NSP(25) ,NEND(25) ,3UNE # 

* SEGMN, SECTN 

COMMON /INTVAL/NSEC(75,25) ,NFTS(25) 

INTEGER*4 IXMAX, IYMAX 

REAL YF(IYMAX) , ZF( IXMAX, IYMAX) ,Y (IYMAX) ,Z (IYMAX) 

REWIND 17 

CALL GETLIN ( IFULOX , IPLOT , IGO) 

JLIN=NSP ( IPLOT) 

JPTS=NPTS ( JLIN) 

DO 24 1=1 , IPTS 
DO 23 J«1,ILINE 
READ(17) Y, Z 
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IF(J.E2.JUN) then 
DO 21 K=l ; IYMAX 
ZF(I,K)=Z(K) 

21 CONTINUE 
IF(I.EQ.l) THEN 

DO 22 K=l, IYMAX 
YF (K) =Y (K) 

22 CONTINUE 
ENDIF 

ENDIF 

23 CONTINUE 

24 CONTINUE 
RETURN 
END 


SUBROUTINE CTNERT(BEND,X, Y) 

Evaluates curve fit of inertance of bends 
DIMENSION B(3) 

DATA B/0 . 0 , 0 . 7877014E-02 , -0 . 2814679E-04 / 

A=B ( 1 ) + (B ( 2 ) +B ( 3 ) *BEND) *BEND 

Y=A*(X-1.0) **2 

RETURN 

END 


SUB R0OT INE HHSECT(J , ITYPE, POINT, LEN,DIA, VOL) 
Conputes plot coordinates for Helmholtz resonator 

INTEGER*2 ITYPE(200) 

XOID=X 

XHOLD=XH 

XLOLD=XL 

YOU>=Y 

YHOLD=YH 


YL0ID=YL 

SINOLD=SINA 

COSOID=OOSA 


DIAM=SQRT( (XH-XL) **2+(YH-YL) **2) 
CALL TSSECT ( J , ITYPE, POINT, LEN, DIA) 
XC=0.5*(XOLD+X) 

YC=0 . 5* (YOUX-Y) 

XOU>=X 

YOIJ>=Y 

SINA=COSOID 


COSA=-SINOLD 
X=XC+COSA* (LEN+0 . 5*DIAM) 

Y=YC+SINA* (LEN+0 . 5*DIAM) 

SIDE=VOL**0. 3333333 

CALL STSECT(J, ITYPE, POINT, SIDE, SIDE) 

X=XOLD ’ 


Y=YOID 


SINA=SINOLD 

OOSA=OOSOLD 


DIAM=SQRT( (XHOLD-XLOLD) **2+(YHOLD-YLOLD) **2) 
XH=X-0 . 5*SINA*DIAM 
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XL=X+0 . 5*SINA*DIAM 
YH=Y+0 . 5*C0SA*DIAM 
YL=Y-0 . 5*C0SA*DIAM 
RETURN 
END 


SUBROUTINE LOWERW(LFREQ,HFREQ, ADMMAX) 

Sets up lower plotting window 
COMMON /NOCOL/MODE , MODET , NTROWS , NTOOLS , NPROWS , NPOOLS 
COMMON / ADMCOL/ADMBAC , ADMLIN 
INTEGER ADMBAC, ADMLIN 
REAL LFREQ 
XMTN=LFREQ 


XMAX=HFREQ 
YMEN=0. 0 


YMAX=ADMMAX 

XORG=XMIN 

YORG=YMXN 


XLEN=0 . 01* (XMAX-XMEN) 
YLEN=0 . 01* (YMAX-YMIN) 
XMTN=XMTN-XT ,EM 
XMAX=XMAX+XLEN 
YMTN=YMTN-VT ,PN 
YMAX=YMAX+YLEN 
JC0L1=150 
JCOL2=550 

IF (MODE. EQ. 6) THEN 
JR0W1=20 
JR0W2=79 
ELSE 
JROW1=40 

IF(M0DE.E1Q.16) JROW2=134 

IF (MODE. EQ. 18) JROW2=199 

ENDIF 


YOVERX=l . 0 

IOPT=0 

ASPECT=1.35 

CALL QPIOT ( JCOL1 , JOOL2 , JROW1 , JRCW2 , XMIN, XMAX, YMTN, YMAX . 
* XORG, YORG, IOPT, YOVERX, ASPECT) 

IF (MODE. NE. 6) THEN 
CALL QPREJG(0, AEMBAC) 

ENDIF 


CALL QSETUP(0, ADMLIN, -2 ,ADMLIN) 
REHJRN 
END 


SUBROUTINE IDX(S,GOX,IUNIT,IUNITP / IGONE) 
Handles lox piping logic 
COMPLEX GOX(25) ,S 


OMMON /EPARAM/MENG,TFLOW(25) ,PCHMB(25) ,DPROR(25) ,FMRAT(25) 
INTEGER SEGMN(25) ,SECIN(75,25) ,NOLINE(25) ,IENG(25) ,ITANK(25) 
k LOPOLD(25) ,IOPEND(25) 

REAL KMAN (25) ,KTANK(25) ,LF1£W(25) ,L(75,25) 

COMMON /PARAM/MLINE, SPLIT (25) ; A(25) ,CMRN(25) ,CTANK(25) , 
k DENS (25) ,KMAN,K!I!A^ ,VOLMF(25) , 



* AREA(75, 25) ,DIA(75,25) ,L,PIND(75, 25) , 

* PCAP(75, 25) ,AVGK(25) , 

* SEGMN , SECTN , NOLINE , IENG , ITANK , LOPOLD , LOPEND 
COMMON /POPIPE/PIPE1 (75, 25) ,PIPE2 (75,25) ,PIPE3 (75,25) , 

* PIPE4 (75,25) , PIPES (75, 25) 

CHARACTER* 2 4 LOXIN,NAMLIN(2) 

COMMON /WCAOUT/NAMLIN 
CHARACTER* 1 ANS 
IF(IGONE.EQ.2) THEN 

WRTIEC*, ' (A\) ') ' Is the lox file name IOX.RIN? (Y/N) ' 

READ(*, ' (A) ' ) ANS 

IF(ANS.NE. 'N' .AND.ANS.NE. 'n') THEN 
OPEN (UNIT=IUNIT, FILE= ' DOX . RLN ' ) 

NAMLIN(2) = 'IJ^X.RLN , 

ELSE 

WRITE(*, ' (A\) ') ' Enter name of file with lox line data 1 

READ(*, ' (A) ' ) LOXIN 

OPEN (UNIT=IUNIT, FILE=LOXIN) 

NAMLIN ( 2 ) =LOXIN 
ENDIF 

OPEN ( IUNTTP , PORM= • UNFORMATTED ' ) 

ENDIF 

CALL FULOX (S , GOX, SEGMN, SECIN, PIPE1 , PIPE2 , PIPE3 , PIPE4 , PIPES , 

* A, AREA, AVGK,CMAN, CLANK, DENS, DIA,IENG,IGONE, ITANK, 

* IUNTT,IUNITP,KMAN,KTANK,L, LOPEND, DOPOID,LF1£W,MLINE, NOLINE, PCAP, 

* PIND , SPLIT , VOL , VOLMF , 2 ) 

RETURN 

END 

SUBROUTINE MDDENG ( IUNIT , NAMENG) 

C Modifies engine parameters 

OOMMON /EPARAM/MENG,TFLOW(25) / PCHMB(25) ,DPROR(25) ,FMRAT(25) 

CHARACTER* 2 4 NAMENG 

CHARACTERS NAME 

CHARACTER* 1 ANS 

CHARACTER*8 VARL(3) ,VARU(3) 

DATA VARL/ 'tflow ' , 'pchmb ' , 'dpror '/ 

DATA VARU/'TFIOW ','PCHMB • , 'DPROR '/ 

DO 25 J=1,MENG 

WRITE(*, ' (A,A,I3,A\) ') ' Do you wish to change flew conditions 

* 'for engine #',J, '? ' 

READ(*, ' (A) 1 ) ANS 

IF(ANS.NE. 'Y' .AND.ANS.NE. 'y') GO TO 25 
21 CONTINUE 

WRITE(*,*)' ' 

WRITE (*,*) ' VARIABLE NAMES AND VALUES’ 

WRITER,*)' ' 

WRITE(*, ' (A, 1PE15. 5) ') ' TFLOW - total mass flow (ltm/sec) 

* TFIOW(J) 

WRITE(*, ' (A, 1PE15. 5) ') ' PCHMB - chamber pressure (lbf/ft~2) 

* PCHMB (J) 

WR1TE(*/ 1 (A,1PE15.5) ') 1 DPROR - orfice pressure drop (lbf/ft“2) 

* DPROR (J) 

WRITE(*,*)' ' 
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Enter variable name and new value, or' 

$ to print variable names & values, or' 
E3® when all changes have been made' 


WRITE(*, *) ' 

WRITE(*,*) ' 

WRITE(*, *) ' 

WRITE(*,*) ' ' 

22 CONTINUE 

WHITE (*, ' (A\) ' ) ' Enter variable name and new value HO or # 
CALL ZREAD (NAME, VALUE) ' ^ U ' ° r # 

IF(NAME.EQ. '#’) GO TO 21 
IF(NAME.EQ. 'END' .OR.NAME.EQ. 'end') GO TO 25 

DO 23 11=1,3 
I=II 

IF(NAME.EQ.VARU(I) .OR.NAME.EQ.VARL(I) ) GO TO 24 

23 CONTINUE U 

WRITE (*,*) ' Invalid name, try again' 

GO TO 21 

24 CONTINUE 

IF(I.EQ. 1) TFLCW ( J) =VALUE 
IF(I.EQ. 2) PCHMB ( J) =VALUE 
IF(I.EQ. 3) DPROR ( J) =VALUE 
PMRAT ( J) =PCHMB ( J) /TFLCW ( J) 

GO TO 22 

25 CONTINUE 

W -)ANS 150 yOU “ iSh theS * Chan ^ es? * » N • 

IF(ANS.NE. 'Y'.AND.ANS.NE. 'y') RETURN 
WRITE ( * , ' (A,A,A\) ') ' Do you wish to use file 1 ,NAMENG 

* '? Y or N • 

READ(*/ ' (A) ' ) ANS 

IF(ANS.NE. ' Y' .AND.ANS.NE. 'y' ) 1HEN 
WR^TEf*/ ' (A\) ') ' Enter name of file to use ' 

PEAD(*, ' (A) ' )NAMENG 
CLOSE (UNIT=IUNIT) 

OPEN (UNIT=IUNIT, FILE)=NAMENG) 

ELSE 

WRITE(*, ' (A,A,A\) ') ' Do you wish to rewind ',NAMENG 

* '? Y or N ' 

READ(*, • (A) ' ) ANS 

IF(ANS.EQ. 'Y' .OR.ANS.EQ. 'y' ) REWIND IUNIT 
ENDIF 

WRITE (IUNIT, ' (15) ' )MENG 
DO 26 J=1,MENG 

26 cSe™' ' (1P3E15 - 5 ) ')TFICW(J) , PCHMB (J) ,DPROR(J) 

RETURN 

END 

SUBROUTINE MODIFY (TTTL, SEGMN, SECIN, PIPE1 , PIPE2 PIPED 

* ' P ?? E5 ' L,AREA ' DIA f PIND, PCAP, LOPEND, LOPOID, SPLIT, IUNIT 

Allows modifications to input data 

SS / / S^^'™ (25), ^ (25) ' DproR(25, ' WRM '( 25 ) 

CHARACTER*24 NAMLIN(2) 
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COMMON /WCAOUT/NAMLIN 
REAL SPUT(25) ,AVGK(25) 

REAL AREA(75, 25) ,DIA(75,25) ,L(75,25) ,PIND(75, 25) , 

* PCAP(75, 25) 

REAL PIPE1 (75,25), PIPE2 (75,25), PIPE3 (75,25) , PIPE4 (75,25), 

* PIPE5 (75,25) 

INTEGER SEGMN(25) ,SECIN(75,25) 

INTEGER ITANK(25) ,IENG(25) ,LOPOID(25) ,LOPEND(25) ,NOLINE(25) 

REAL A(25) ,CTANK(25) ,DENS(25) ,KTANK(25) ,CMAN(25) ,KMAN(25) , 

* LFLOW(25) ,VOL(25) ,VOIMF(25) 

CHARACTER*20 TITL 
CHARACTER* 1 ANS 

1 FORMAT (1PE15. 6) 

2 FORMAT(I5, 1P5E15. 6) 

3 FORMAT ( ' This segment is a bend of ' ,IPE13.5, ' deg and radius of* 

* E13.5) 

4 FORMAT ( ' This segment is straight ',1PE13.5, ' diameter pipe *, 

* E13.5, ' ft. long') 

5 FORMAT ( ' This segment is a manifold with' ,1PE13. 5, ' vol.', 

* E13.5, ' bulk modulus') 

6 FORMAT ( ' This segment is a pump with length =' ,1PE13.5, ' dia =' , 

* E13.5/5X, 'dp/dm =',E13. 5, ' capacitance =',E13. 5, 

* ' inductance =',E13.5) 

7 FORMAT (' This segment is a tuned pipe ' ,1PE13.5, ' long & dia =' , 

* E13.5) 

8 FORMAT (' This segment is a Helmholtz resonator with'/5X, 'length =' 

* , 1PE13.5,' dia =' ,E13.5, ' and vol =' ,E13.5) 

9 FORMAT (' This segment is a parallel resonator with'/5X, 'length =', 

* 1PE13.5, ' dia = ' , E13 . 5 , ' and vol =',E13.5) 

10 FORMAT ( ' This segment is a',lPE13.5, ' long inline acc. with', 

* ' diameter of ' , E13 . 5) 

IF(IUNIT.EQ.ll) THEN 

NAMNAM=1 

ELSE 

NAMNAM=2 

ENDIF 

WRITE (*, ' (A\) ') ' Do you wish to change tank parameters? ' 

READ(*, ' (A) ' ) ANS 

IF(ANS.EQ. 'Y'.OR.ANS.EQ. 'y') THEN 
CALL MODTAN (MEANK , VOL , LF1CW , KTANK , DENS , A, CEANK) 

ENDIF 

WRITE (*, ' (A\) ') ' Do you wish to change the pipe layout? ' 

READ(*, • (A) ' ) ANS 

IF(ANS.NE. 'Y' .AND. ANS. NE. ' y ' ) GO TO 28 
IP=0 

DO 27 M=1,MUNE 
IP=IP+1 
IT=ITANK (M) 

DO 26 IPP=IP, IP+SPLIT (M) 

1=0 

ISEO^N=SEGMN(IPP) 

DO 25 11=1 , SBGMN ( IPP) 

1=1+1 
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IF (SECIN (I, IPP) .EQ.O) THEN 
WRITE (*, 3) PIPED (I, IPP) ,PIPE1(I,IPP) 

E1£ETF(SECIN(I,IPP) .EQ.l) THEN 
WRITE ( * , 4 ) PIPE2 ( I , IPP) ,PIPE1(I, IPP) 

ELSEIF(SECIN(I,IPP) .EQ.2) THEN 
WRITE(*, 10) PIPE1 (I, IPP) , PIPE2(I, IPP) 

ELSEIF(SECIN(I,IPP) .EQ.3) THEN 
WRITE(*,7)PIPE1(I,IPP) ,PIPE2 (I, IPP) 

ELSEIF(SECIN(I, IPP) .EQ.4) THEN 
WRITE (* , 8) PIPE1 (I , IPP) , PIPE2 (I, IPP) , PIPE3 (I , IPP) 

EILSEIF (SECIN (I, IPP) .EQ.5) THEN 
WRITE(*,9)PIPE1(I,IPP) ,PIPE2 (I, IPP) ,PIPE3 (I, IPP) 
ELSEIF(SECIN(I,IPP) .EQ.6) THEN 
WRITE(*,6)PIPE1(I,IPP) ,PIPE2 (I, IPP) , PIPE3 (I, IPP) f 

* PIPE4 (I , IPP) , PIPES (I, IPP) 

ELSErF(SECIN(I,IPP) .BQ.7) THEN 

WRITE(*, 5) PIPE1 (I, IPP) ,PIPE2 (I, IPP) 

ENDIF 

WRITE (*, ’ (A\) ') ' You may keep (K) , modify (Y) , delete (D) , • , 

* ' add before (B) , or add after (A) ? ' 

READ(*, ' (A) 1 ) ANS 

IF(ANS.E)Q. 'A' .OR.ANS.EQ. 'a') THEN 
1=1+1 

DO 21 III=ISBGMN, I, -1 
PIPE1 ( III+l , IPP) =PIPE1 ( III , IPP) 

PIPE2 (III+l , IPP) =PIPE2 (III , IPP) 

PIPED (III+l , IPP) =PIPE3 (III , IPP) 

PIPE4 (III+l , IPP) =PIPE4 (III, IPP) 

PIPES (III+l, IPP) =PIPE5 (III, IPP) 

L ( III+l , IPP) =L ( III , IPP) 

DIA (III+l , IPP) =DIA ( III , IPP) 

AREA ( III+l , IPP) =AREA ( III , IPP) 

PCAP (III+l , IPP) =PCAP(III , IPP) 

PIND (III+l , IPP) =PIND (III , IPP) 

SECIN ( III+l , IPP) =SECIN (III , IPP) 

21 CONTINUE 
ISEGMN=ISE)GMN+1 
GO TO 24 

ELSEIF(ANS.EQ. 'B'. OR.ANS.EQ. 'b') THEN 
DO 22 III=ISBGMN,I,-1 
PIPE1 (III+l , IPP) =PIPE1 (III , IPP) 

PIPED (III+l , IPP) =PIPE2 (III , IPP) 

PIPED (III+l, IPP) =PIPED( III, IPP) 

PIPE4 ( III+l , IPP) =PIPE4 (III , IPP) 

PIPES (III+l , IPP) =PIPE5 ( III , IPP) 

L ( III+l , IPP) =L ( III , IPP) 

DIA ( III+l , IPP) =DIA ( III , IPP) 

AREA ( III+l , IPP) =AREA ( III , IPP) 

PCAP(III+1, IPP)=PCAP(III, IPP) 

PIND ( III+l , IPP) =PIND ( III , IPP) 

SECTN ( III+l , IPP) =SECIN ( III , IPP) 

22 CONTINUE 
ISEGMN=ISBGMN+1 
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THEN 


ELSEIF (ANS . BQ . 'D' .OR.ANS.EQ. 'd') 

DO 23 III=I,ISEEMN 
PIPE1 ( III , IPP) =PIPE1 ( III+l , IPP) 

PIPE2 ( III , IPP) =PIPE2 ( III+l , IPP) 

PIPED ( III , IPP) =PIPE3 (III+l, IPP) 

PIPE4 ( III , IPP) =PIPE4 (III+l , IPP) 

PIPES (III , IPP) =PIPE5 (III+l, IPP) 

L (III, IPP) =L( III+l, IPP) 

DIA (III, IPP) =DIA (III+l, IPP) 

AREA ( III , IPP) =AREA ( III+l , IPP) 

PCAP ( III , IPP) =PCAP ( III+l , IPP) 

PIND (III , IPP) =PIND (III+l , IPP) 

SECTN ( III , IPP) =SECTN ( III+l , IPP) 

CONTINUE 
1=1-1 

ISEGMN=ISEGMN-1 
GO TO 25 

ELSELF(ANS.NE. 'Y' .AND. ANS. NE. 'y') THEN 
GO TO 25 
ENDIF 
CONTINUE 

WRITE(*,*) ' Specify 0 for BEND, 1 for STRAIGHT pipe, ' 

WRTTE(*,*) ' 2 for INLINE ACCUM. , 3 for TUNED STUB, ' 

WRTTE(*,*) ' 4 for HELMHOLTZ RES., 5 for PARALLEL RES. 1 

WRITER*,*) ' 6 for PUMP, 7 for MANIFOLD' 

READ(*,*) SECT 

IF(SECT.LT. O.OR.SECT.GT.7) GO TO 24 
SECIN (I , IPP) =SECT 
IF(SECT.BQ.O) THEN 
bend in pipe 

WRITE(*,*) ' RADIUS of bend along CL(ft) , ANGLE of bend (deg) , ' 
WRITE(*,*) 1 DIAMETER ( ft) , and LENGTH(ft) beyond bend of pipe' 
READ(*,*)PIPE1(I,IPP) , PIPE2 (I, IPP) , PIPED (I, IPP) ,PIPE4 (I, IPP) 
CALL PTYPE(SECTN(I,IPP) ,PIPE1(I,IPP) , PIPED (I, IPP) , 

PIPED (I , IPP) , PIPE4 (I , IPP) , PIPES (I , IPP) , L (I , IPP) , 
AREA (I, IPP) ,DIA(I,IPP) ,PIND(I,IPP) ,PCAP(I,IPP) , 
AVGK(M) , DENS (IT) ,CMAN(IPP) ,KMAN(IPP) ,VOLMF(IPP) ) 
ELSEIF(SECT.E)Q.l) THEN 
straight section 

WRITE(*,*) ' Specify LENGTH (ft) and DIAMETER (ft) of segment' 
READ(*,*) PIPE1(I,IPP) ,PIPE2 (I,IPP) 

CALL RTYPE ( SECTN ( I , IPP) ,PIPE1(I,IPP) , PIPED (I, IPP) , 

PIPED (I, IPP) ,PIPE4 (I, IPP) ,PIPE5(I,IPP) ,L(I,IPP) , 
AREA (I, IPP) ,DIA(I,IPP) , PIND (I, IPP) ,PCAP(I,IPP) , 
AVGK(M) , DENS (IT) ,CMAN(IPP) ,KMAN(IPP) ,VOLMF(IPP) ) 
ELSEIF(SECr.E)Q.2) THEN 
inline accumulator 

WRITE(*,*)' Specify LENGTH (ft) fit DIAMETER (ft) of', 

' accumulator ' 

READ(*, *) PIPE1(I,IPP) ,PIPE2(I,IPP) 

CALL RTYPE (SECIN (I , IPP) , PIPE1 (I , IPP) , PIPED (I , IPP) , 

PIPED (I, IPP) , PIPE4 (I, IPP) , PIPES (I, IPP) ,L(I, IPP) , 



* AREA (I IPP) ,DIA(I,IFP) ,PIND(I,IPP) ,PCAP(I,IPP) , 

l ^(M)^NS (IT) ,<W(IPP) ,KMAN(IPP) ,VOLMF(IPP) ) 

ELSEIF(SECr.BQ.3) THEN 

W RTI^^)^ t ^ecify LENGTH (ft) & DIAMETER (ft) of tuned stub' 
R£AD(*,*)PIPE1(I,IPP) ,PIPE2 (I, IPP) , r , , 

CALL RTYPE(SECTN(I,IPP) ,PIPE1(I,IPP) 

* PIPE3 (I, IPP) ,PIPE4 (I, IPP) ,PIPE5(I,IPP) I ,IPP ) , 

* AREA(I,IPP) ,DIA(I,IPP) ,PIND(I,IPP) ,PCAP(I,IPP) / 

* AVGK(M) ,DENS (IT) ,CMAN(IPP) ,KMAN (IPP) ,VOLMF (IPP) ) 

ELSEIF(SECT.EQ.4) THEN 

LENGTH (ft) , DIAMETER (ft) , VOLUME ’ , 

* ' (ft*3) of Helmholtz Resonator' 

READ (*,*) PIPE1 (I, IPP) , PIPE2 (I, IPP)/ PTPE3 (I /IPP) 

CALL KTYPE(SECIN(I,IPP) ,PIPE1(I,IPP) ,PIPE2(I / IPP / 

* PIPE3 (I, IPP) , PIPE4 (I , IPP) , PIPE5 (I, IPP) , L(!/IPP) / 

* AREA(I IPP) ,DIA(I,IPP) ,PIND(I,IPP ,PCAP(I,IPP) , 

* ^(M)Ss(iT) ,^®N(ipp) /KMAN(IPP) ,VOIMF(IPP)) 

ELSEIF(SECr.EQ.5) THEN 

WRIT^^^S^S^I^GIH (ft), DIAMETER (ft) , VOLUME \ 

* • (ft~3) of Parallel Resonator' 

READ(*,*)PIPE1(I,IPP) ,PIPE2 (I, IPP) ,PIPE3(I,IPP) 

CALL RTYPE(SECIN(I,IPP) ,PIPE1(I,IPP) ,PIPE2 (I,IPP) / 

* PIPE3 (I, IPP) ,PIPE4 (I, IPP) ,PIPE5(I,IPP) >L( I >IPP ) / 

* AREA(I IPP) ,DIA(I,IPP) ,P3ND(I,IPP) ,PCAP(I,IPP) , 

* AVGK(M) TdENS (IT) , CMAN(IPP) ,KMAN(IPP) ,VOIMF(IPP)) 
ELSEIF(SECr.B2.6) THEN 

WRTIE(*,*) ' Specify LENGTH (ft), DIAMETER (ft) , dp/dm, CAP. , 

* ' & IND. of pump' 

READ(*,*)PIPE1(I,IPP) ,PIPE2(I,IPP) ,PIPE3 (I, IPP) , 

* PIPE4 (I, IPP) ,PIPE5(I,IPP) 

CALL RTYPE(SECIN(I,IPP) ,PIPE1(I,IPP) ,PIPE2 I,IPP) , 

* PIPE3 (I, IPP) ,PIPE4 (I, IPP) , PIPES (I, IPP) ,L(I, IPP) , 

* AREA (I, IPP) ,DIA(I,IPP) ,PIND(I,IPP) . 

* AVGK(M) , DENS (IT) ,CMAN(IPP) ,KMAN(IPP) ,VOIMF(IPP) ) 

ELSETF ( SECT . BQ . 7 ) THEN 

WRITE^*^*r d Specify VOLUME (ft~3) and BUIK MODUUJS (lbf/ft'2) ' 
READ(*,*) PIPE1 (I , IPP) , PIPE2 (I, IPP) 

CALL RTYPE(SECIN(I,IPP) ,PIPE1(I,IPP) ,PIPE2 (I, IPP) , 

* PIPED ( I , IPP) ,PIPE4 (I, IPP) ,PIPE5(I,IPP) ,L(I, IPP) , 

* AREA(I,IPP) ,DIA(I,IPP) ,PIND(I,IPP) /^^(I / IPP)/ 

* AVGK(M) , DENS (IT) ,CMAN(IPP) ,KMAN(IPP) ,VOIMF(IPP) ) 

ENDIF 

25 CONTINUE 

SBGMN ( IPP) =ISEGMN 

26 CONTINUE 

IF(SPLIT(M) .NE.0.0) THEN , . . , 

WRrTE(*, ' (A, 13) ') ' Maximum no. of iterations is set. at , 

* IOPOLD(M) 
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WRITE(* ; ' (A\) ') ' Do you wish to change it? ' 

READ(*, ' (A) • JANS 

IF(ANS.BQ. * Y * .OR.ANS.EQ. * y ■ ) 1HEN 
WREEEf*, ' (A\) ') ' Enter maximum no. of iterations ' 

READ(*, *) LOPOID(M) 

ENDIF 

DDPEND (M) =LOPOID (M) 

ip=ip+split (Mj 
ENDIF 

27 CONTINUE 

28 CONTINUE 

WRite (*, 1 (A\) * ) ' Do you wish to save these changes? Y or N * 
READ(*, ' (A) ' JANS 

IF(ANS.NE. ' Y' .AND.ANS.NE. 'y 1 ) RETURN 

WRITE(*, 1 (A, A,A\) ') ' Do you wish to use file * , NAMLIN (NAMNAM) 

* '? Y or N ' 

READ(* f ' (A) 'JANS 

IF(ANS.NE. 'Y' .AND.ANS.NE. 'y'J THEN 
WRETEt*, ' (A\) ') ' Enter name of file to use ' 

READ(*, ' (A) 1 ) NAMLIN (NAMNAM) 

CLOSE (UNIT=IUNIT) 

OPEN (UNTT=rUNIT, FILE=NAMLIN (NAMNAM) ) 

ELSE 

WRETEC*/ ' (A,A,A\) ') ' Do you wish to rewind ' .NAMLIN (NAMNAM) 

* '? Y or N ' 

READ(*, • (A) 'JANS 

IF(ANS.EQ. 'Y'. OR.ANS.BQ. 'y'J REWIND IUNIT 
ENDIF 
IP=0 

WRITE (IUNIT, ' (A) ' JTTTL 
WRITE (IUNIT, 2 JMTANK 
DO 29 M=1,MTANK 
WRITE (IUNIT, 1) VOL (M) 

WRITE ( IUNIT , 1 ) LFLOW (M) 

WRITE ( IUNIT , 1 ) KTANK (M) 

WRITE (IUNIT, 1J DENS (M) 

29 CONTINUE 

WRITE (IUNIT, 2 JMLINE 
DO 33 M=1,MLINE 
IP=IP+1 

WRITE (IUNIT, 2) ITANK(M) 

WRITE (IUNIT, 2 ) IENG (IPJ 
WRITE (IUNIT, 2 ) SEQ4N ( IP) 

WRITE(IUNIT, 2) SPLIT (M) 

DO 30 J=1 , SBGMN ( IP) 

WRITE (IUNIT, 2 )SECIN(J, IP) ,PIPE1(J,IP) ,PIPE2(J,IP) ,PIPE3(J,IP) , 
* PIPE4 ( J, IP) , PIPE5 ( J, IP) 

30 CONTINUE 

IF(SPLIT(M) .EQ.O) GO TO 33 
DO 32 K=l, SPLIT (M) 

IP=IP+1 

WRITE (IUNIT, 2) SEI2^N( IP) 

WRITE (IUNIT, 2 ) NOLINE (IP) 
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IF(I.EQ. 2) LFLCW ( J) =VALLJE 
IF(I.BQ. 3) KTANK ( J) =VALUE 
IF(I.EQ. 4) DENS ( J) =VALUE 
A ( J) =SQRT (GRAV*KTANK ( J) /DENS ( J) ) 

CTANK ( J) =DENS ( J) *VOL ( J) /KTANK ( J) 

GO TO 22 
25 CONTINUE 
RETURN 
END 

SUBROUTINE PIPPIOT ( SEQ4N , SECIN , PIPE1 , PIPE2 , PIPE3 , PIPE4 , HOX 
* _ ITANK, IENG) 

C Supervises plot of piping layout 

COMMON / ARCCON/ XC , YC , RAD , ANG , ANGLE 

OQMNDN /PIPPXY/X, XH,XL, Y, YH,YL, XMIN, XMAX, YMIN, YMAX, SINA, OOSA 

EXTERNAL XFUN,YFUN 

DfTEGER*2 SE®IN, SECIN (75) ,ITYPE (200) 

REAL PIPE1 (75) ,PIPE2(75) ,PIPE3(75) ,PIPE4(75) 

REAL POINT(8, 200) ,XP(2),YP(2) 

ANG=0. 0 
ANGLE=0. 0 
OOSA=1 . 0 
SINA=0. 0 
X^O • 0 
XH=0.0 
XIfO • 0 
Y=0. 0 

IF(SECIN(1) .EQ.O) THEN 
YH=Y+0 . 5*PIPE3 (1) 

YD=Y-0.5*PIPE3(1) 

ELSEIF (SECIN (1) .GE.3.AND.SECTN(1) .LE.5) THEN 
IF(SECIN(2) .EQ.O) THEN 
YH=Y+0. 5*PIPE3 (2) 

YL=Y-0 . 5*PIPE3 (2 ) 

ELSE 

YH=Y+0.5*PIPE2(2) 

YL=Y-0.5*PIPE2(2) 

ENDIF 

ELSE 

YH=Y+0 . 5*PIPE2 ( 1 ) 

YL=Y-0.5*PIPE2(1) 

ENDIF 

J=0 

XMIN=0.0 
XMAX=0. 0 

YMIN=AMIN1 (Y, YL, YH) 

YMAX=AMAX1 (Y, YL, YH) 

DO 21 I=1,SEX34N 
IF (SECIN (I) .EQ.O) THEN 
C bend 

CALL BNSECT ( J , ITYPE, POINT, PIPE1 (I) ,PIPE2 (I) , PIPE3 (I) , PIPE4 ( I) ) 
ELSEIF (SECIN (I) .EQ.l) THEN K " 

C straight section 

CALL STSECT(J, ITYPE, POINT, PIPE1 (I) ,PIPE2(I)) 


•>'?*' 


'V -’.ATM 


►'»( v ;) 


84 



ELSEEF(SECTN(I) .EQ.2) THEN 
C inline accumulator 

CALL STSECT(J,ITYPE,POINT,PIPEl(I) ,PIPE2(I) ) 
ELSEIF(SECrN(I) .EQ.3) THEN 
C tuned stub 

CALL TSSECT(J, ITYPE, POINT, PIPE1 (I) ,PIPE2(I) ) 
ELSEIF(SECIN(I) .EQ.4) THEN 
C helmholtz resonator 

CALL HHSECT ( J, ITYPE, POINT, PIPE1 (I) ,PIPE2(I) ,PIPE3(I) ) 
ELSEIF(SECIN(I) .EQ.5) THEN 
C parallel resonator 

CALL PLSECT(J, ITYPE, POINT, PTPE1 (I) ,PIPE2(I) , PIPED (I) ) 
ELSEIF(SECIN(I) .E3Q.6) THEN 
C pump 

CALL £TSECT(J, ITYPE, POINT, PIPE1 (I) ,PIPE2(I) ) 

ENDIF 

21 CONTINUE 

XRANGE>=XMAX-XMIN 
YPANGE=YMAX-YMIN 
XMIN=XMIN-0 . 05*XRANGE 
XMAX=XMAX+0 . 05*XRANGE 
YMIN=YMIN-0 . 05*YRANGE 
YMAX=YMAX+0 . 05*YRANGE 

CALL UPPERW (XMIN, YMIN, XMAX, YMAX, HjOX, ITANK, IENG) 

DO 22 1=1, J 

IF(ITYPE(I) .EQ.O) THEN 
C bend 

XC=POINT (1,1) 

YC=POINT(2, I) 

Xl=POINT(3, I) 

Yl=POINT (4 , 1) 

RAD=POINr(5,I) 

IF(Xl.GT.Yl) THEN 
Xl=3 . 14159+X1 
Yl=3 . 14159+Y1 

CALL QOJRV (XFUN, YFUN, Y1,X1) 

ELSE 

CALL QCURV (XFUN, YFUN, XI, Yl) 

ENDIF 

ELSE 

C all except bend 

XO=POINT (1,1) 

YO=POINT(2 , 1) 

Xl=POINT(3 , I) 

Yl=POINT(4 , I) 

X2=POINT (5,1) 

Y2=POINT(6, I) 

X3=POINT(7,I) 

Y3=POINT(8,I) 

XP(1)=X0 

YP(1)=Y0 

XP(2)=X1 

YP(2)=Y1 
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CALL QTABL ( 1 , 2 , XP , YP) 

XP(1)=X2 
YP(1)=Y2 
XP(2)=X3 
YP ( 2 ) =Y3 

CALL QTABL ( 1 , 2 , XP , YP) 

XP(1)=X0 
YP(1)=Y0 
XP(2)=X2 
YP ( 2 ) =Y2 

CALL QTABL(1,2,XP,YP) 

XP(1)=X1 
YP(1) =Y1 
XP(2)=X3 
YP ( 2 ) =Y3 

CALL QTABL(1,2,XP,YP) 

ENDIF 

22 CONTINUE 
RETURN 
END 

SUBROUTINE PDOISU(X,Y,Z,XF,YF,ZF,IPTS / IXMAX,IYMAX,IFULOX,MLINE) 

C Supervises the surface plot 

INTEGER SEGMN, SECIN ( 150) 

OCMMON /SETUP/PIPE1 (150) ,PIPE2 (150) ,PIPE3 (150) ,PIPE4 (150) , 

* NENG(25) ,NTANK(25) ,NLINE(25) ,NSP(25) ,NEND(25) , ILINE, 

* SEGMN, SECIN 
CHARACTER* 40 TITLE 
CHARACTER* 20 TITL 

INTEGER* 2 IHR, DON, IYR, IMON, IDAY 
CHARACTER*2 AP 

OCMMON /VOYTIT/TITLE, TITL, IHR, MEN, AP, IYR, IMON, IDAY 
COMMON / FACTOR/ SFAC 
INTEGER*4 IXMAX,IYMAX 

REAL XF(IXMAX) , YF(IYMAX) , ZF(IXMAX,IYMAX) 

REAL X(IPTS,IYMAX) , Y(IFTS, IYMAX) , Z (IPTS, IYMAX) 

INTEGER* 2 IWRK1 (640) , IWRK2 (640) 

CHARACTER* 1 ANS 
CHARACTER*38 PIPING 
CHARACTER*45 LEGEND 
CHARACTER*58 LEGENDR, LEGENDH 
CHARACTER*4 FOPIPE(2) 

DATA FOPIPE/ 'FUEL' , ' LOX' / 

DATA LEGEND/ 1 Pressure Transfer Function = f(freq, distance) '/ 

DATA LEGENDR/ ' Pressure Transfer Function = f(freq (rad/sec) ,distanc 
*e(ft) ) '/ 

DATA LEGENDH/' Pressure Transfer Function = f (freq (Hertz ), distance 
*(ft)) '/ 

DATA ASPECT/ 1.35/ 

DATA IOOLR/4/ , IFIL/3/ , ILIN/1/ 

1 FORMAT ( 1 Current view is PHI =' ,F8.3, ' IHETA =',F8.3) 

2 FORMAT ( ' Current BACKGROUND COLOR = 1 ,12, ' LINE COLOR = ' ,12, 

* ' FELL COLOR = ',12) 

3 FORMAT ( IX, A4, ' Piping - Tank #', 13 , 3X, ' Engine #',I3) 
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IGOOO 

CALL QRMODE (MODET , NOOLT) 

CALL QVIDBD ( IBOARD ) 

IF(IBOARD.LT. l.OR. IBOARD. G?T. 3) THEN 
WRITE(*,*) ' Graphics board not installed!' 

RETURN 

ENDIF 

IF(IBOARD.EQ.l) MDDE=6 
IF(IBOARD.BQ.2) M0DE=16 
IF (IBOARD. BQ. 3) MODE=18 
IWIRE=0 

IF ( IBOARD. NE.l) THEN 

WRITE (*, ' (A\) ') ' Do you want a wire-frame drawing? ' 

READ(*, ' (A) ' ) ANS 

IF(ANS.EQ. 'Y'.OR.ANS.EQ. 'y') IWIRE)=1 
ENDIF 

21 CONTINUE 

CALL GETZF(Y, Z, YF, ZF, IXMAX, IYMAX, IPIS, JPTS, IFUDOX, IPLOT, IGOO) 
IF(IPDOT.EQ.O) RETURN 

WRITE ( PIPING , 3 ) FOPIPE ( IFULOX) ,NIANK (IPLOT) ,NENG (IPLOT) 
XMIN=XF(1) 

XMAX=XF ( IPTS ) 

YMIN=YF(1) 

YMAX=YF ( JPTS) 

ZMIN=ZF(1 / 1) 

ZMAX=ZF(1, 1) 

DO 22 J=l, JPTS 
DO 22 1=1, IPTS 

IF(ZMIN.GT.ZF(I, J) ) ZMD^ZF(I,J) 

IF(ZMAX.LT.ZF(I, J) ) ZMAX=ZF(I,J) 

22 OCNITNUE 
YLEN=YF ( JPTS) -YF ( 1) 

XLEN=XF (IPTS) -XF(1) 

ZLEN=ZMAX-ZMIN 

IF (XLEN.EQ.O.O.OR.YLEN.EQ.O.O.OR.ZLEN.EQ.O.O) STOP 1 
XYZLEN=AMAX1 (XLEN, YLEN, ZLEN) 

XFAC=XYZLEN / XLEN 
XINV=1.0/XFAC 
YFAC=XYZLEN /YLEN 
YINV=1 . 0/ YFAC 
ZFAC=XYZLEN / ZLEN 
ZINV=1 . 0/ZFAC 
DO 23 J=l, JPTS 
DO 23 1=1, IPTS 
X(I, J) =XF (I) *XFAC 
Y(I, J)=YF(J) *YFAC 
Z(I, J)=ZF(I, J) *ZFAC 

23 CONTINUE 
XMIN=XMIN*XFAC 
XMAX=XMAX*XFAC 
YMIN=YMIN*YFAC 
YMAX=YMAX*YFAC 
ZMIN=ZMIN*ZFAC 


87 


ZMAX=ZMAX* ZFAC 
XMAJ=0 . 2 * (XMAX-XMIN) 

YMAJ=0 . 2 * ( YMAX-YMIN) 

ZMAJ=0 . 2 *( ZMAX-ZMIN) 

P=-45.0 
T=30. 0 

CALL Q3DR0T(X,Y,Z,IPTS,JFTS,P,T) 

24 CONTINUE 

CALL QSMODE (MODE) 

IF(IBQARD.NE.l) CALL QPREG(0,ICOIR) 

CALL WINDOW (MODE, ASPECT, XMIN, XMAX, YMIN, YMAX, ZMIN, ZMAX) 
CALL Q3DXAX (XMIN, XMAX, XMAJ, 0, -1,2, YMIN, YMAX, ZMIN,XINV) 
CALL Q3DYAX(YMIN, YMAX, YMAJ, 0,-1, 2, XMAX, XMIN, ZMIN, YINV) 
CALL Q3DZAX( ZMIN, ZMAX, ZMAJ, 0,-1, 2, XMIN, YMIN, ZINV) 

IF (MODE. BQ. 6) THEN 
CALL QPTXr(40,TTTLE,7,17,23) 

CALL QPTXT(45,LEGEND,7, 15, 22) 

CALL QPTXT (38, PIPING, 7, 18,21) 

ELSEIF (MODE . EQ . 16 ) THEN 
CALL QPTXT(40,TTTLE,7,17,23) 

IF(SFAC.EQ.l.O) IHEN 
CALL QPTXT ( 58, LEGENDR, 7,8,22) 

ELSE 

CALL QPTXT (58 , LEGENDH, 7,8,22) 

ENDIF 

CALL QPTXT (38, PIPING, 7, 18,21) 

ELSE 

CALL QPTXT(40, TITLE, 7, 17,27) 

IF(SFAC.EQ.l.O) IHEN 
CALL QPTXT (58, LEGENDR, 7, 8, 26) 

ELSE 

CALL QPTXT (58 , LEGENDH, 7,8,26) 

CALL QPTXT(38,PIPING, 7, 18, 25) 

ENDIF 

ENDIF 

IF(IBOARD.EQ.l.OR.IWIRE.EQ.l) IHEN 
CALL Q3DSTK(X,Y,IPTS,JPTS,IWRK1 > IWRK2, 640,1) 

ELSE 

CALL Q3DFIL(X, Y, IFTS, JPTS, IFIL,ILIN) 

ENDIF 

25 CONTINUE 

CALL QONKEY (IKEY) 

IF(IKEY.EQ.O) GO TO 25 
CALL QINKEY (IEXTEN, IKEY) 

CALL QSMODE (MODET) 

IGO=0 

WRITE(*,1)P,T 

WRil't(*, ' (A\) ') ' Do you wish another view? ' 

READ(*, ' (A) 1 ) ANS 

IF(ANS.EQ. 'Y'.OR.ANS.EQ. ’y') THEN 

WRITE (*/ ' (M) ') ' Enter new viewing angles PHI & THETA. 
READ(*,*)P,T 

CALL Q3DINV(X,Y,Z,IPTS,JPTS) 
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CALL Q3DR0T(X, Y, Z,IPTS, JPTS,P,T) 

IG0=1 

ENDIF 

IF(IBOARD.NE.l) THEN 
WRITE ( * , 2 ) IOOLR, LLIN, IFIL 

WRITE(*, ' (A\) ' ) ' Do you wish another color? 1 
READ(*, ' (A) 1 ) ANS 

IF(ANS.EQ. 'Y'.OR.ANS.EQ. 'y') THEN 

WRITE(*, *) ' Enter color number (0-63) for BACKGROUND, LINE, 
* and FILL * 

WRITE (*,*) 1 4,1,3 will give the default colors 1 

WRITE(*, ' (A\) ') 1 0,7,0 will give black & white ' 

READ (*,*) IOOLR, ILIN, IFIL 
IGO=l 
ENDIF 
IWR=0 

IF(IWIRE.EQ.O) THEN 

WRITE(*, ' (A\) ') ' Do you want a wire-frame drawing? ' 

READ(*, ' (A) * ) ANS 

IF(ANS.EQ. 'Y'.OR.ANS.EQ. 'y') THEN 
IWR=1 
IGO=l 
ENDIF 
ELSE 

WRITE(*, ' (A\) ') ' Do you want a filled drawing? ' 

READ(*, ' (A) ' ) ANS 

IF(ANS.EQ. 'Y' .OR.ANS.EQ. 'y') THEN 
IWR=2 
IGO=l 
ENDIF 
ENDIF 

IF(IWR.EQ.l) IWIRE=1 
IF(IWR.E)Q.2) IWIRE>=0 
ENDIF 

IF(IGO.NE.O) GO TO 24 
IF (MLINE.GT. 1) THEN 

WRTTE(*, ' (A\) ') ' Do you want another surface plot? ' 

READ(*, ' (A) ' ) ANS 

IF(ANS.EQ. ' Y' .OR.ANS.EQ. 'y ' ) GO TO 21 
ENDIF 
RETURN 
END 

SUBROUTINE PLSECT(J,ITYPE, POINT, LEN,DIA, VOL) 

C Computes plot coordinates for parallel resonator 

COMMON /PIPPXY/X,XH,XL,Y,YH,YL,XMIN,XMAX,YMIN,YMAX,SINA, OOSA 
COMMON /ARCCON/XC , YC , RAD , ANG , ANGLE 
REAL LEN, POINT (8, 200) 

INTEGER* 2 ITYPE(200) 

XOU>X 

XHOLD=XH 

XLOLD=XL 

YOLD=Y 

YHOLD=YH 
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YLDLD=YL 

ANGOLD=ANG 

ANGSAV=ANGLE 

SINOLD=SINA 

GOSOLD=COSA 

DIAM=SQKT( (XH-XL) **2+(YH-YL) **2) 

CALL STSECT ( J , ITYPE , POINT , DIA , DIAM) 

XG=0 . 5* (XHOLD+XH) 

XHC=XHOLD 

XLC=XL 

YC=0 . 5* (YHOLEH-YH) 

YHC=YHOLD 

YLC=YL 

PLEN=LEN-2 . 0*DIA 

PDIA= (VOL-2 . 0*DIA*DIAM) /PLEN 

CALL STSECT (J, ITYPE, POINT, PLEN, PDIA) 

CALL STSECT (J, ITYPE, POINT, DIA, DIAM) 

XSAV=X 

XHSAV=XH 

XLSAV=XL 

YSAV=Y 

YHSAV=YH 

YLSAV=YL 

SINA=COSOLD 

OOSA=-SINOLD 

RADIUS=DIA 

TURN=-90. 0 

SIDE=LEN-5 . 0*DIA 

ANG=ANG+1 . 5708 

ANGLE=ANGLE+90 . 0 

X=XC 

Y=YC 

XH=XHC 

XLr=XLC 

YH=YHC 

YL=YLC 

CALL BNSECT(J, ITYPE, POIOT, RADIUS, TURN, DIA, DIA) 

CALL STSECT (J, ITYPE, POINT, SIDE, DIA) 

CALL BNSECT(J, ITYPE, POINT, RADIUS, TURN, DIA, DIA) 

X=XSAV 

Y=YSAV 

XH=XHSAV 

XL=XLSAV 

YH=YHSAV 

YL=YLSAV 

ANG=ANGOLD 

ANGLE=ANGSAV 

SINA=SINOID 

COSA=COSOLD 

RETURN 

END 

SUBROUTINE PLTCON(X,Y,Z,XF,YF,ZF,IPTS,IXMAX,IYMAX,IFUlJDX,MLINE) 
C Supervises plot of contour plot 
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INTEGER SBGMN, SECIN(150) 

OOKJN / SETUP/PIPE1 (150) ,PIPE2(150) ,PIPE3(150) ,PIPE4(150) , 

* NENG(25) ,NTANK(25) ,NLINE(25) ,NSP(25) ,NEND(25) ,ILINE / 

* SEX34N,SECIN 
CHARACTER* 40 TITLE 
CHARACTER* 20 TTTL 

INTEGER* 2 IHR, HUN, IYR, IMON, IDAY 
CHARACTER*2 AP 

COMMON /WCATIT/TITLE,TTTL, IHR, IMIN, AP, IYR, IMON, IDAY 

COMMON / FACTOR/ SFAC 

INTEGER*4 DCMAX, IYMAX 

REAL XF(IXMAX) , YF(IYMAX) , ZFflXMAX.IYMAX) 

REAL X(IPTS) ,Y (IYMAX) , Z (IPTS, IYMAX) , CONS (10) 

INTEGER* 2 LABL(IO) 

CHARACTER* 3 8 PIPING 
CHARACTER*4 F0PIPE(2) 

DATA FOPIPE/ 'FUEL' , ' LOX'/ 

DATA ASPECT/1.35/ 

DATA LABL/1, 0,0, 0,1, 0,0, 0,1,0/ 

DATA IOOLR/4/, IFIL/3/, ILIN/1/ 

1 FORMAT ( IX, A4, ' Piping - Tank 13 , 3X, ' Engine #',I3) 

2 FORMAT ( ' Current BACKGROUND COLOR = ',12, ' LINE COLOR = ',12 

* ' FILL COLOR = ',12) 

IGO=0 

CALL QRMODE (MODET , NOOLT) 

CALL QVIDBD ( TBOARD) 

IF(IBOARD.LT. l.OR.IBOARD.GT.3) THEN 
WRITE (*,*) ' Graphics board not installed! ' 

RETURN 

ENDIF 

IF(IBOARD.EQ.l) M0DE=6 
IF(IBOARD.EQ.2) MODE=16 
IF (IBOARD. EQ. 3) MODE=18 

21 CONTINUE 

CALL GETZF(Y, Z, YF, ZF, IXMAX, IYMAX, IPIS, JPTS, IFULOX, IPDOT, IGO) 
IF(IPLOT.EQ.O) RETURN 

WRITE ( PIPING , 1 ) FOPIPE ( IFULOX) ,NTANK(IPIOT) ,NENG(IPLOT) 

XMIN=XF(1) 

XMAX=XF ( IPTS) 

YMIN=YF(1) 

YMAX=YF ( JPTS ) 

ZMH£=ZF(1,1) 

ZMAX=ZF(1, 1) 

DO 22 J=l, JPTS 
Y(J)=YF(J) 

DO 22 1=1, IPTS 
IF(J.E)Q.l) X(I)=XF(I) 

Z(I,J)=ZF(I,J) 

IF(ZMIN.GT.Z(I, J) ) ZMIN=Z(I,J) 

IF(ZMAX.LT.Z(I, J) ) ZMAX=Z (I, J) 

22 CONTINUE 

ZLEN=0 . 1* ( ZMAX-ZMIN) 

DO 23 1=1,9 
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CONS (I) =I*ZLEN 

23 CONTINUE 

XMAJ=0 . 2* (XMAX-XMIN) 

YMAJ=0 . 2* (YMAX-YMIN) 

24 CONTINUE 

CALL QSMODE (MODE) 

IDEF=2 

IF(IBOARD.NE.l) THEN 
IDEF=2 

CALL QPEEG ( 0 , ICOLR) 

ENDIF 

CALL QCTRDE(MODE, ILIN,IFIL, ILIN, 1) 

JCOL1=100 

JCOL2=450 

JROW1=40 

IF (MODE. EQ. 6) JROW1=60 
JRQW2=169 

IF (MODE. EQ. 16) JROW2=300 

IF(MODE.EQ.18) JROW2=409 

XORG=XMIN 

YOFG=YMIN 

YOVERX=l . 0 

IOPT=0 

IF (MODE. NE. 18) THEN 
CALL QPrXT(40,TITLE,7,17,23) 

CALL QFTXT(38, PIPING, 7, 18,22) 

ELSE 

CALL QPTXT(40,TTTLE,7, 17,27) 

CALL QPTXT( 38, PIPING, 7, 18,26) 

ENDIF 

CALL QPLOT ( JOOL1 , JOOL2 , JPCW1 , JFCW2 , XMIN , XMAX , YMIN , YMAX , 

* XOPG, YOPG, IOPT, YOVERX, ASPECT) 

CALL QXAXIS (XMIN, XMAX, XMAJ, 0,-1, 2) 

CALL QYAXIS (YMIN, YMAX, YMAJ, 0,-1, 2) 

IF(SFAC.EQ.l) THEN 

CALL QPTXTA ( 17 , * Frequency-rad/sec ' , 7) 

ELSE 

CALL QPTXTA (17, ' Frequency-Hertz ',7) 

ENDIF 

CALL QPTXID(7, 'X - ft. 1 ,7) 

CALL QCNTOU (ASPECT, X,Y,Z, CONS, LABL,IPTS,JPTS, 9, IDEF) 

25 cmnNUE 

CALL QONKEY (IKEY) 

IF(IKEY.EQ.O) GO TO 25 
CALL QINKEY (IEXTEN,IKEY) 

CALL QSMODE (MODET) 

IF(IBOARD.NE.l) THEN 
WRITE (*, 2 ) ICOLR, ILIN, IFIL 

WRITE(*, ' (A\) ') ' Do you wish another color? ' 

READ(*, ' (A) ' )ANS 

IF(ANS.EQ. 'Y' .OR.ANS.EQ. 'y') THEN 
WRITE(*,*) 1 Enter color number (0-63) for BACKGROUND, LINE, 

* and FILL ' 
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WRITE (*,*) ' 4,1,3 will give the default colors ' 

WRITE (*, ' (A\) ') 1 0,7,7 will give black & white ' 

READ ( * , * ) ICOLR, ILIN , IFIL 
GO TO 24 
ENDIF 
ENDIF 

IF(MUNE.GT.l) THEN 

WRITE(*, 1 (A\) ') ' Do you want another contour plot? ' 

READ(*, ' (A) ' )ANS 

IF(ANS.EQ. 'Y' .OR.ANS.EQ. 'y * ) GO TO 21 
ENDIF 
RETURN 
END 

SUBROUTINE RUNE (TTTL, SBGMN, SECTN, PIPE1 , PIPE2 , PIPE3 , 

* PIPE4, PIPES, L, AREA, DIA,PIND,PCAP,DDPEND,D3POLD, SPLIT, IUNIT, 

* A,CMAN,CTANK,DENS,KMAN,KTANK,LFLCW,VOL,VOIMF,NOUNE,IENG,rrANK, 

* AVGK,MUNE) 

C Reads fuel or lox file. 

COMMON /EPARAM/MENG,TFLCW(25) ,PCHMB(25) ,DPROR(25) ,FMRAT(25) 

COMMON /TANK/MTANK 
REAL SPLIT (25) ,AVGK(25) 

REAL AREA(75,25) ,DIA(75,25) ,L(75,25) ,PIND(75,25) , 

* PCAP(75,25) 

REAL PIPE1(75,25) ,PIPE2 (75, 25) ,PIPE3 (75,25) ,PIPE4 (75,25) , 

* PIPES (75, 25) 

INTEGER SEGMN(25) ,SECIN(75,25) 

INTEGER ITANK(25) ,IENG(25) ,LOPOLD(25) ,LOPEND(25) ,NOUNE(25) 

REAL A(25) ,CMAN(25) ,CTANK(25) ,DENS(25) ,KMAN(25) ,KTANK(25) , 

* LFL0W(25) ,VOL(25) ,VOIMF(25) 

CHARACTER* 20 TTTL 
CHARACTER* 1 ANS 

READ (IUNIT, ' (A) ')TTTL 

CALL TANKNO (MTANK, VOL, LFLCW, KTANK, DENS , A, CTANK, IUNIT) 

READ (IUNIT, *) MLINE 
IF (MLINE.GT. 25) THEN 

WRITE (*, *) ' Number of lines must be less than 25' 

STOP 

ENDIF 

IF (MLINE. LE.O) MUNE=1 
DO 20 M=l,25 
IENG (M) =0 
20 CONTINUE 
M=0 

DO 24 MM=1, MLINE 
M=M+1 

READ ( IUNIT, *)ITANK (MM) , IENG (M) 

IF(ITANK(MM) .GT. MTANK) THEN 
WRITE(*,*) 1 Invalid tank number. ' 

STOP 

ENDIF 

IF ( IENG (M) .GT.MENG) THEN 
WRITE(*,*) 1 Invalid engine number.' 

STOP 
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ENDIF 

ir=ITANK(MM) 

IE=IENG (M) 

LDPOLD (MM) =2 0 
LDPEND(MM)=1 
AVGK (MM) =0.0 
DIVAVG=0 . 0 

READ(IUNTT / *)SH3W(M) , SPLIT (MM) 

DO 21 1=1 , SEGMN (M) 

READ (IUNIT, *) SECIN (I ,M) ,PIPE1(I,M) ,PIPE2(I,M) ,PIPE3(I,M) , 

* PIPE4(I / M) ,PIPE5(I / M) 

IF(SECIN(I,M) .NE.7) GO TO 21 
AVGK (MM) =AVGK (MM) +PIPE2 ( I , M) 

DIVAVG=DIVAVG+1 

21 CONTINUE 

IF (SPLIT (MM) . EQ. 0) THEN 
AVGK (MM) =KTANK ( IT) 

NOLINE (M)=l 
GO TO 24 
ENDIF 

C split pipe 

DO 23 J=l, SPLIT (MM) 

M=M+1 

READ (IUNIT, *) SEX34N (M) , NOLINE (M) , IENG (M) 

IF(IENG(M) .CT.MENG) THEN 
WRITE (*, *) ' Invalid engine number.' 

STOP 

ENDIF 

IE=IENG(M) 

IF (NOLINE (M) . EQ.O) NOLINE (M) =1 
DO 22 1=1 , SEGMN (M) 

READ (IUNIT, *) SECTN (I,M) ,PIPE1(I,M) ,PIPE2(I,M) ,PTPE3(I,M) , 

* PIPE4 (I,M) , PIPES (I,M) 

IF(SECIN(I,M) .NE.7) GO TO 22 

AVGK (MM) =AVGK (MM) +PIPE2 ( I , M) *NOLINE (M) 
DXVAVG=DTVAVG+NOLINE (M) 

22 CONTINUE 

23 CONTINUE 

WRITE(*, ' (A, 13) ') ' Max. no. of iterations is set at 

* LOPOLD (MM) 

WRITE(*, ' (A\) ') ' Do you wish to change it? ' 

READ(*, ' (A) ')ANS 

IF(ANS.EQ. 'Y' .OR.ANS.EQ. 'y') THEN 
WRITE(*, ' (A\) ') ' Enter maximum no. of iterations ' 

READ (*,*) LDPOLD (MM) 

ENDIF 

LOPEND (MM) =LOPOLD (MM) 

IF(DIVAVG.LE.O.O) DIVAVG=1.0 
AVGK (MM) =KTANK ( IT) +AVGK (MM) /DIVAVG 

24 OCWTINUE 
M=0 

DO 28 MM=1,MLINE 
M=Mfl 
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IT=ITANK (MM) 

IE=IENG(M) 

DO 25 1=1 , SEGMN (M) 

CALL RTYPE(SECTN(I,M) ,PIPE1(I,M) ,PIPE2(I,M) , 

* PIPE3 (I,M) , PIPE4 (I,M) ,PIPE5(I,M) ,L(I,M) ,AREA(I,M) , 

* DIA(I,M) ,PIND(I,M) ,PCAP(I,M) ,AVGK(MM) , DENS (IT) , 

* CMAN(M) ,KMAN(M) ,VOIMF(M) ) 

25 CONTINUE 

IF (SPLIT (MM) . BQ. 0) GO TO 28 
DO 27 J=l, SPLIT (MM) 

M=M+1 

IE=IENG(M) 

DO 26 1=1, SEGMN (M) 

CALL RTYPE(SECTN (I,M) ,PIPE1(I / M) ,PIPE2 (I,M) , 

* PIPE3 (I,M) ,PIPE4(I,M) ,P3PE5(I,M) ,L(I,M) ,AREA(I,M) , 

* DIA(I,M) ,PIND(I,M) ,PCAP(I,M) ,AVGK(MM) ,DENS(IT) , 

* CMAN (M) , KMAN (M) , VOIMF (M) ) 

26 CONTINUE 

27 CONTINUE 

28 CONTINUE 
RETURN 
END 

SUBROUTINE RTYPE ( SECIN, PIPE1 , PIPE2 , PIPE3 , PIPE4 , PIPE5 , L, AREA, DIA, 

* PIND,PCAP,AVGK, DENS, CMAN, KMAN, VOLMF) 

C Stores values for different types of piping 

INTEGER SECIN 
REAL L,KMAN 

DATA GRAV/32. 2/, PI/3. 141593/ 

IF (SECIN. EQ. 0) THEN 

CALL BENDS ( PIPE1 , PIPE2 , PIPE3 , PIPE4 , VALUE , DIME) 

AREAB=0 . 785398*DIME**2 

L=VALUE 

AREA=AREAB 

DIA=DIME 

ELSEIF(SECIN.EQ.l) THEN 
C straight section 

VALUE>=PIPE1 
DIME=PIPE2 

AREAB=0 . 785398*DIME**2 
L=YALUE 
AREA=AREAB 
DIA=DIME 

ELSEIF (SECIN. EQ. 2) THEN 
inline accumulator 
PIPE1 - LEN 
PIPE2 - DIA 
PIPE3 - DEN 
PIPE4 - K 
L=PIPE1 
DIA=PLPE2 

AREA=0 . 25*PI*PIPE2**2 
IF (PIPED. EQ. 0.0) PIPED =DENS 
IF (PIPE4 . BQ. 0. 0) PIPE4=AVGK 
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PCAP=PIPE3*L*AREA/PIPE4 
ELSEIF(SECIN.EQ.3) THEN 

tuned stub - suppresses omega = (PI/2) / (L*SQRT(PIND*PCAP) ) 
PIPE1 - LEN 
PIPE2 - DIA 
PEPE3 - DEN 
PIPE4 - K 
L=PIPE1 
DIA=PIPE2 

AREA=0 . 25*PI*DIA**2 
IF(PIPE3.EQ.0.0) PIPE3=DENS 
IF(PIPE4 . EQ. 0. 0) PIPE4=AVGK 
PCAP=PIPE3 *L*AREA / PIPE4 
PIND=L/ (AREA*GRAV) 

ELSEIF(SECIN.EQ.4.0R.SECIN.EQ.5) THEN 

helxnholtz resonator or parallel resonator 
suppresses omega = 1/SQRT (PIND*PCAP) 

PIPE1 - LEN 
PIPE2 - DIA 
PIPE3 - VOL 
PIPE4 - DEN 
PIPE5 - K 
L=PIPE1 
DIA=PIPE2 
AREA=PEPE3 

IF(PIPE4 . EQ. 0. 0) PEPE4=DENS 
IF(PIPE5.BQ.0.0) PIPE5=AVGK 
PCAP=PIPE4 *AREA/PIPE5 
PIND=L/ ( 0 . 25*PI*DIA**2*GRAV) 

ELSEIF(SECIN.EQ.6) THEN 
punp 

PIPE1 - LEN 
PIPE2 - DIA 
PIPE3 - DP/OVI 
PIPE4 - IND 
PIPE5 - CAP 
L=PEPE1 
DIA=PIPE2 
AREA=PIPE3 
PCAP=PIPE4 
PIND=PIPE5 

ELSEIF ( SECIN . EQ . 7 ) THEN 
mcinifold 
PIPE1 - VOLMF 
PIPE2 - KMAN 
VOLMF=PIPEl 
KMAN=PIPE2 

CMAN=DENS *VOLMF /KMAN 
L=VOLMF 
DIA=CMAN 
ENDIF 
RETURN 
END 
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SUBROUTINE SETPLT 

Sets up the plot environment 
COMMON / WCAPAS / IFRST 

COMMON /NOCOL/MODE , MODET , NTRCWS , NTOOLS , NPRCWS , NPCOLS 

COMMON / ADMOOL/ ADMBAC , ADMLIN 

INTEGER ADMBAC, ADMLIN 

CHARACTER* 1 ANS 

DATA nm/o/ 

IF(ITTM.EQ.O) THEN 
m=i 
AEMBAC=4 
ADMLIN=1 
ENDIF 

CALL QRMODE (MODET, NCOLT) 

CALL QVIDBD ( IBOARD) 

IF(IBOARD.LT. l.OR. IBOARD.GT. 3) THEN 
WRITE (*, *) ' Graphics board not installed! ' 

RETURN 

ENDIF 

IF ( IBOARD. EQ.l) THEN 
M0DE=6 
NFROWS=200 
NIROWS=25 
ENDIF 

IF (IBOARD. EQ. 2) THEN 
MODE=16 
NPROWS=350 
NTROWS=25 
ENDIF 

IF ( IBOARD. EQ. 3) THEN 
MODE=18 
NPROWS=480 
NTROWS=25 
ENDIF 
IFRST=0 
NTCOLS=NCOLT 
NPC0LS=640 
IF (MODE. NE. 6) THEN 

WRITE(* / ' (A\) ') ' Do you wish change colors of admittance? ' 
READ(*, ' (A) ' ) ANS 

IF(ANS.EQ. ' Y' .OR.ANS.EQ. *y * ) THEN 

WRITE (*,*) ' Enter no. of background color and no. of line color' 
WRITE (*,*) ' 4,1 will give the default colors ' 

WRITE(*, ' (A\) ') ' 0,7 will give black & white ' 

READ (*,*) ADMBAC , AEMLIN 
ENDIF 
ENDIF 

CALL QSMODE (MODE) 

RETURN 

END 

SUBROUTINE STSECT ( J, TTYPE, POINT, LEN, DIA) 

Computes plot coordinates for a straight section 
COMMON /PIPPXY/X,XH,XL, Y, YH, YL,XMIN,XMAX,YMIN,YMAX,SINA,OOSA 



REAL LEN, POINT (8, 200) 

INTEGER* 2 ITYPE (200) 

J=J+1 

ITYPE (J)=l 

XH=X-0 . 5*SINA*DIA 

XLr=X+0 . 5*SINA*DIA 

YH=Y+0 . 5*COSA*DIA 

YL=Y-0 . 5*OOSA*DIA 

POINT ( 1 , J) =XH 

POINT ( 2 , J) =YH 

POINT(3,J)=XL 

POINT ( 4 , J) =YL 

X=X+OOSA*LEN 

XH=X-0 . 5*SINA*DIA 

XL=X+0 . 5*SINA*DIA 

Y=Y+SINA*LEN 

YH=Y+0 . 5*COSA*DIA 

YLfY-0 . 5*COSA*DIA 

POINT ( 5 , J) =XH 

POINT ( 6 , J) =YH 

POINT(7, J)=XL 

POINT(8, J)=YL 

XMIN=AMIN1 (X, XL, XH , XMIN) 

XMAX=AMAX1(X,XL,XH,XMAX) 

YMIN=AMIN1 (Y,YL, YH, YMIN) 

YMAX=AMAX1 (Y , YL, YH, YMAX) 

RETURN 

END 

SUBROUTINE TANKNO (MTANK, VOL, LFD3W,KIANK, DENS, A, CTANK, IUNIT) 

C Reads tank parameters 

REAL VOL(25) ,LFLOW(25) ,KEANK(25) ,DENS(25) ,A(25) ,CTANK(25) 
DATA GRAV/32. 2/ 

READ (IUNIT,*) MTANK 
IF(MTANK.GT. 25) THEN 

WRITE(*, *) ' Number of tanks must be less than 25' 

STOP 

ENDIF 

IF (MTANK. LE.O) MTANK=1 
DO 21 1=1, MTANK 

READ (IUNIT, *)VOL(I) ,LFL0W(I) ,KTANK(I) ,DENS(I) 

A (I) =SQRT (GRAV*KTANK (I) /DENS (I) ) 

CIANK(I)=DENS(I) *VOL(I) /KTANK(I) 

21 CONTINUE 
RETURN 
END 

SUBROUTINE TSSECT (J, ITYPE, POINT, LEN, DIA) 

C Computes plot coordinates for a tuned stub 

COMMON /PIPPXY/X,XH, XL, Y,YH,YL, XMIN, XMAX, YMIN, YMAX, SINA,COSA 
REAL LEN, POINT (8, 200) 

INTEGER* 2 ITYPE (200) 

J=J+1 
ITYPE (J)=l 

DIAM=SQRT( (XH-XL) **2+(YH-YL) **2) 
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XH=X-SINA* (LEN+0 . 5*DIAM) 

YH=Y+OOSA* (LEN+0 . 5*DIAM) 

POINT (1,J)=XH 

POINT ( 2 , J) =YH 

POINT ( 3 , J) =XL 

POINT (4 , J) =YL 

X=X+OOSA*DIA 

XH=X-SINA* (LEN+0 . 5*DIAM) 

XL=XL+OOSA*DIA 

Y=Y+SINA*DIA 

YH=Y+OOSA* (LEN+0 . 5*DIAM) 

YL=YL+SINA*DIA 

POINT ( 5 , J) =XH 

POINT ( 6 , J) =YH 

POINT (7 , J)=XL 

POINT ( 8 , J) =YL 

XMIN=AMIN1 (X,XL,XH,XMIN) 

XMAX=AMAX1(X,XL,XH,XMAX) 

YMIN=AMIN1(Y,YL,YH, YMIN) 

YMAX=AMAX1(Y,YL,YH,YMAX) 

RETURN 


SUBROUTINE UPPERS (XO , YO , XI , Y1 , ITULOX, ITANK, IENG) 

Sets up upper plotting winder 

COMMON /NOOOL/MODE ( MODET , NIROWS , NTOOLS , NPRCWS , NPOOI^ 
COMMON / ADMCOL/ AEMEAC , ADMLIN 
INTEGER ADMBAC, ADMLIN 

CHARACTER*36 FUIDX . 

K)RMAT('FUEL Piping - Tank # ‘,12,’ Engine # ,12) 

POPMATC LOX Piping - Tank # ',12,' Engine # ,12) 

XMIN=XO 

XMAX=X1 

YMIN=Y0 

YMAX=Y1 

JOOL1=100 

JOOL2=550 

IF (MODE. EQ. 6) THEN 
JROW1=100 
JR0W2=179 

EL SELF (MODE . EQ . 16 ) THEN 
JP0W1=214 
JR0W2=309 

ELSEIF (MODE . EQ . 18 ) THEN 
JR0W1=244 
JPOW2=449 
ENDIF 
XORG=XMIN 
YORG=YMIN 
YOVERX=l . 0 
IOFT=l 
ASPECT=T. 35 

QPLCT ( JCOL1 , JCOL2 , JPCW1 , JPCW2 , XMIN , XMAX , YMIN , YMAX , 
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* XORG , YORG , IOPT , YOVERX , ASPECT) 

IF(IOPT.GE.O) GO TO 21 

IOPT=l 

CHANGE= (YMAX-YMIN) / (YMAXO-YMIN) 

JCX)L2=JCOL1+0 . 98*CHANGE* ( J00L2-JC0L1) 

* XORG, YORG, IOPT, YOVERX, ASPECT) 

21 CONTINUE 

IF (MODE. NE. 6) THEN 
CALL QFREG ( 0 , AEMRAC) 

ENDIF 

CALL QSETUP(0,AEMLIN,-2,AEMLIN) 

IF(IFULOX.EQ.l) THEN 

fuel line 

WRITE (FULOX, 1) ITANK, IENG 

ELSE 

lox line 

WRITE (FULOX , 2 ) ITANK, IENG 
ENDIF 

IF (MODE. NE. 18) THEN 
CALL QPTXT(36,FULOX,7 ,24,23) 

ELSE 

CALL QPTXT(36,FULOX,7 ,24,27) 

ENDIF 

RETURN 

Routine vproJ(TOE,xscAi£,xsi,XFiN,vsT,wiN,zsr,ZFiN) 

JOOL1=100 

JC0L2=450 

JROW1=40 

JRCW2=169 

IF (MODE. EQ. 16) JRCW2=319 

IF (MODE. EQ. 18) JRCW2=409 

XORG=XMIN 

YORG=YMIN 

YOVERX=l . 0 

IOPT=0 

CALL^QPLOT^JCOLl, JCOL2, JRCW1, JRCW2,XMIN,XMAX, YMIN,YMAX, 

* XORG, YORG, IOPT, YOVERX, ASPECT) 

return 

END 

FUNCTION XFUN(T) 

: Parametric function for plotting of bends 

COMMON /ARCCON/XC,YC, RAD, ANG, ANGLE 
XFUN=XC+RAD*SIN (T) 

RETURN 

END 

FUNCTION YFUN(T) 

c parametric function for plotting of bends 



COMMON / ARCCON/XC , YC , RAD , ANG , ANGLE 
YFUN=YC-RAD*COS (T) 

return 

END 

SUBROUTINE ZREAD (NAME, VALUE) . 

Reads input for input modification 

SSS S( 8 80) ,PIUS,MINUS,PERI0D,LE,E,M^R(10) 

S*1 LEKD(3) ,io®(3) .POUND.WESr.BIK.OM® 
CHARACTER* 1 LTIT(5) ,Ci‘IT(5) 

CHARACTER* 80 DCARD 

dma ian 7 , t , , , i',’t , , , x , , , e , /,crrr/ , T , , , i , . , T . l , e / 

1 FORMAT (A) 

DO 21 1=1,8 
NAME(I)=BLK 
21 CONTINUE 

READ (*,1) DCARD 
IF (CARD (1) .EQ. POUND) THEN 
NAME (1) =POUND 
RETURN 
ENDIF 

IF (CARD (1) .EQ. QUEST) THEN 
NAME(1)=QUEST 

return 

ENDIF 

°?FtaWci? .NE.LB®(I) .SND.CfiED(I) .NE.CTMD(I)) GO TO 23 
NAME(I)=CEND(I) 

22 CONTINUE 

return 

23 CONTINUE 

D IF(CARD(I) .NE.LTIT(I) .AND.CARD(I) .NE.CTIT(I) ) GO TO 25 
NAME(I)=CTIT(I) 

24 CONTINUE 

return 

25 CONTINUE 
DO 26 1=1,8 

IF^CARD(I) .BQ.BLK.OR.CARD(I) .EQ. COMMA) GO TO 27 
NAME(I)=CARD(I) 

26 CONTINUE 

27 CONTINUE 

DO 28 1=11,80 

STcftRD(I) .NE.BLK.AND.CAPD(I) .NE.OCM®) GO TO 29 

28 CONTINUE 

VALUE=0 . 0 . , 

Write (*,*) ' No value given, ZERO assumed 
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RETURN 
29 CONTINUE 
SIGN=1.0 

IF(CAPD(ID) .BQ. MINUS) THEN 
SIGN=-1.0 

id=ieh-i 

ELSEIF (CARD (ID) .EQ.PLUS) THEN 
ID=ID+1 
ENDIF 
WHOLE=0.0 
DO 32 I=ID, 80 


IF(CAFD(I).BQ.PERIOD) GO TO 31 
IF(CAHD(I). EQ.PLUS) GO TO 38 
IF(CARD(I) .EQ. MENUS) GO TO 38 
IF(CARD(I) .EQ.E.OR.CARD(I) .EQ.LE) 
DO 30 J=l,10 


GO TO 37 


IF(CARD(I) . BQ. NUMBER (J) ) 


GO TO 31 


30 CONTINUE 

valub=sign*whole 

IF (CARD (I) .EQ.BLK) RETURN , 

WRiTE(*,*) ' Input error, value set to ZERO 

VALUEO.O 

RFIURN 


31 OONTINUE 

WHOLE=WHOLE* 10 . 0+JJ 


32 CONTINUE 

VALUE=SIGN*WHOLE 


RETURN 
33 CONTINUE 

h>=ii+i 

FRACT=0.0 
ICOUNT=0 
DO 36 I=ID, 80 
ICOUNT=ICOUNT+l 


II=I 

IF(CARD(I) .EQ. PERIOD) THEN 
WRITE (*,*) ' Input error, value set to ZERO 

VALUE>=0.0 

P'FTTYJRN 


ENDIF _ „„ 

IF (CARD (I) .EQ.PLUS) GO TO 38 
IF(CARD(I) .BQ. MINUS) GO TO 38 
IF(CARD(I) .EQ.E.OR.CARD(I) .EQ.LE) 
DO 34 J=l,10 


GO TO 37 


JJ=J-1 

IF(CARD(I) .EQ.NUMBER(J) ) 


GO TO 35 


34 CONTINUE 

VALUE=SIGN* (WHOLE+FRACT) 

IF(CARD(I) .EQ.BLK) RETURN , 

WRITE (*,*) ' Input error, value set to ZERO 


VALUE=0.0 
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RETURN 

35 CONTINUE 

FRACT=FRACr+J J / 1 0 . 0**ICOUNT 

36 CONTINUE 

VALUE=SIGN* (WHOLE+FRACT) 

RETURN 

37 CONTINUE 
11 = 11+1 

38 CONTINUE 

VALUE=SIGN* (WHOLE+FRACT) 

SIGN=1.0 

IF (CARD (II) .EQ. MINUS) THEN 
SIGN=-1.0 
11 = 11+1 

ELSEIF(CARD(II) .EQ.PLUS) THEN 
11 = 11+1 
ENDIF 
WHOLE=0.0 
DO 41 1=11,80 
DO 39 J=l,10 
JJ=J-1 

IF (CARD (I) .EQ.NUMBER(J) ) GO TO 40 

39 CONTINUE 

VALUE=VALUE*10 . 0** (SIGN+WHOLE) 

IF(CARD(I) .EQ.BLK) RETURN 

WRITE(*,*) ' Input error, value set to ZERO' 

VALUE=0.0 

RETURN 

40 CONTINUE 

WHOLE=WHOLE* 10 . 0+JJ 

41 CONTINUE 

VALUE=VALUE*10 . 0** (SIGN*WHOLE) 

RETURN 

END 
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